Session Timed_Automata

Theory Floyd_Warshall

theory Floyd_Warshall
  imports Main
begin

chapter ‹Floyd-Warshall Algorithm for the All-Pairs Shortest Paths Problem›

subsubsection ‹Auxiliary›

lemma distinct_list_single_elem_decomp: "{xs. set xs  {0}  distinct xs} = {[], [0]}"
proof (standard, goal_cases)
  case 1
  { fix xs :: "'a list" assume xs: "xs  {xs. set xs  {0}  distinct xs}"
    have "xs  {[], [0]}"
    proof (cases xs)
      case (Cons y ys)
      hence y: "y = 0" using xs by auto
      with Cons xs have "ys = []" by (cases ys, auto)
      thus ?thesis using y Cons by simp
    qed simp
  }
  thus ?case by blast
qed simp


section ‹Cycles in Lists›

abbreviation "cnt x xs  length (filter (λy. x = y) xs)"

fun remove_cycles :: "'a list  'a  'a list  'a list"
where
  "remove_cycles [] _ acc = rev acc" |
  "remove_cycles (x#xs) y acc =
    (if x = y then remove_cycles xs y [x] else remove_cycles xs y (x#acc))"

lemma cnt_rev: "cnt x (rev xs) = cnt x xs" by (metis length_rev rev_filter)

value "as @ [x] @ bs @ [x] @ cs @ [x] @ ds"

lemma remove_cycles_removes: "cnt x (remove_cycles xs x ys)  max 1 (cnt x ys)"
proof (induction xs arbitrary: ys)
  case Nil thus ?case
  by (simp, cases "x  set ys", (auto simp: cnt_rev[of x ys]))
next
  case (Cons y xs)
  thus ?case
  proof (cases "x = y")
    case True
    thus ?thesis using Cons[of "[y]"] True by auto
  next
    case False
    thus ?thesis using Cons[of "y # ys"] by auto
  qed
qed

lemma remove_cycles_id: "x  set xs  remove_cycles xs x ys = rev ys @ xs"
by (induction xs arbitrary: ys) auto

lemma remove_cycles_cnt_id:
  "x  y  cnt y (remove_cycles xs x ys)  cnt y ys + cnt y xs"
proof (induction xs arbitrary: ys x)
  case Nil thus ?case by (simp add: cnt_rev)
next
  case (Cons z xs)
  thus ?case
  proof (cases "x = z")
    case True thus ?thesis using Cons.IH[of z "[z]"] Cons.prems by auto
  next
    case False
    thus ?thesis using Cons.IH[of x "z # ys"] Cons.prems False by auto
  qed
qed

lemma remove_cycles_ends_cycle: "remove_cycles xs x ys  rev ys @ xs  x  set xs"
using remove_cycles_id by fastforce

lemma remove_cycles_begins_with: "x  set xs   zs. remove_cycles xs x ys = x # zs  x  set zs"
proof (induction xs arbitrary: ys)
  case Nil thus ?case by auto
next
  case (Cons y xs)
  thus ?case
  proof (cases "x = y")
    case True thus ?thesis
    proof (cases "x  set xs", goal_cases)
      case 1 with Cons show ?case by auto
    next
      case 2 with remove_cycles_id[of x xs "[y]"] show ?case by auto
    qed
  next
    case False
    with Cons show ?thesis by auto
  qed
qed

lemma remove_cycles_self:
  "x  set xs  remove_cycles (remove_cycles xs x ys) x zs = remove_cycles xs x ys"
proof -
  assume x:"x  set xs"
  then obtain ws where ws: "remove_cycles xs x ys = x # ws" "x  set ws"
  using remove_cycles_begins_with[OF x, of ys] by blast
  from remove_cycles_id[OF this(2)] have "remove_cycles ws x [x] = x # ws" by auto
  with ws(1) show "remove_cycles (remove_cycles xs x ys) x zs = remove_cycles xs x ys" by simp
qed

lemma remove_cycles_one: "remove_cycles (as @ x # xs) x ys = remove_cycles (x#xs) x ys"
by (induction as arbitrary: ys) auto

lemma remove_cycles_cycles:
  "x  set xs   xxs as. as @ concat (map (λ xs. x # xs) xxs) @ remove_cycles xs x ys = xs  x  set as"
proof (induction xs arbitrary: ys)
  case Nil thus ?case by auto
next
  case (Cons y xs)
  thus ?case
  proof (cases "x = y")
    case True thus ?thesis
    proof (cases "x  set xs", goal_cases)
      case 1
      then obtain as xxs where "as @ concat (map (λxs. y#xs) xxs) @ remove_cycles xs y [y] = xs"
      using Cons.IH[of "[y]"] by auto
      hence "[] @ concat (map (λxs. x#xs) (as#xxs)) @ remove_cycles (y#xs) x ys = y # xs"
      by (simp add: x = y)
      thus ?thesis by fastforce
    next
      case 2
      hence "remove_cycles (y # xs) x ys = y # xs" using remove_cycles_id[of x xs "[y]"] by auto
      hence "[] @ concat (map (λxs. x # xs) []) @ remove_cycles (y#xs) x ys = y # xs" by auto
      thus ?thesis by fastforce
    qed
  next
    case False
    then obtain as xxs where as:
      "as @ concat (map (λxs. x # xs) xxs) @ remove_cycles xs x (y#ys) = xs" "x  set as"
    using Cons.IH[of "y # ys"] Cons.prems by auto
    hence "(y # as) @ concat (map (λxs. x # xs) xxs) @ remove_cycles (y#xs) x ys = y # xs"
    using x  y by auto
    thus ?thesis using as(2) x  y by fastforce
  qed
qed

fun start_remove :: "'a list  'a  'a list  'a list"
where
  "start_remove [] _ acc = rev acc" |
  "start_remove (x#xs) y acc =
    (if x = y then rev acc @ remove_cycles xs y [y] else start_remove xs y (x # acc))"

lemma start_remove_decomp:
  "x  set xs   as bs. xs = as @ x # bs  start_remove xs x ys = rev ys @ as @ remove_cycles bs x [x]"
proof (induction xs arbitrary: ys)
  case Nil thus ?case by auto
next
  case (Cons y xs)
  thus ?case
  proof (auto, goal_cases)
    case 1
    from 1(1)[of "y # ys"]
    obtain as bs where 
      "xs = as @ x # bs" "start_remove xs x (y # ys) = rev (y # ys) @ as @ remove_cycles bs x [x]"
    by blast
    hence "y # xs = (y # as) @ x # bs"
          "start_remove xs x (y # ys) = rev ys @ (y # as) @ remove_cycles bs x [x]" by simp+
    thus ?case by blast
  qed
qed

lemma start_remove_removes: "cnt x (start_remove xs x ys)  Suc (cnt x ys)"
proof (induction xs arbitrary: ys)
  case Nil thus ?case using cnt_rev[of x ys] by auto
next
  case (Cons y xs)
  thus ?case
  proof (cases "x = y")
    case True
    thus ?thesis using remove_cycles_removes[of y xs "[y]"] cnt_rev[of y ys] by auto
  next
    case False
    thus ?thesis using Cons[of "y # ys"] by auto
  qed
qed

lemma start_remove_id[simp]: "x  set xs  start_remove xs x ys = rev ys @ xs"
by (induction xs arbitrary: ys) auto

lemma start_remove_cnt_id:
  "x  y  cnt y (start_remove xs x ys)  cnt y ys + cnt y xs"
proof (induction xs arbitrary: ys)
  case Nil thus ?case by (simp add: cnt_rev)
next
  case (Cons z xs)
  thus ?case
  proof (cases "x = z", goal_cases)
    case 1 thus ?case using remove_cycles_cnt_id[of x y xs "[x]"] by (simp add: cnt_rev)
  next
    case 2 from this(1)[of "(z # ys)"] this(2,3) show ?case by auto
  qed
qed

fun remove_all_cycles :: "'a list  'a list  'a list"
where
  "remove_all_cycles [] xs = xs" |
  "remove_all_cycles (x # xs) ys = remove_all_cycles xs (start_remove ys x [])"

lemma cnt_remove_all_mono:"cnt y (remove_all_cycles xs ys)  max 1 (cnt y ys)"
proof (induction xs arbitrary: ys)
  case Nil thus ?case by auto
next
  case (Cons x xs)
  thus ?case
  proof (cases "x = y")
    case True thus ?thesis using start_remove_removes[of y ys "[]"] Cons[of "start_remove ys y []"]
    by auto
  next
    case False
    hence "cnt y (start_remove ys x [])  cnt y ys"
    using start_remove_cnt_id[of x y ys "[]"] by auto
    thus ?thesis using Cons[of "start_remove ys x []"] by auto
  qed
qed


lemma cnt_remove_all_cycles: "x  set xs  cnt x (remove_all_cycles xs ys)  1"
proof (induction xs arbitrary: ys)
  case Nil thus ?case by auto
next
  case (Cons y xs)
  thus ?case
  using start_remove_removes[of x ys "[]"] cnt_remove_all_mono[of y xs "start_remove ys y []"]
  by auto
qed

lemma cnt_mono:
  "cnt a (b # xs)  cnt a (b # c # xs)"
by (induction xs) auto
  
lemma cnt_distinct_intro: " x  set xs. cnt x xs  1  distinct xs"
proof (induction xs)
  case Nil thus ?case by auto
next
  case (Cons x xs)
  from this(2) have " x  set xs. cnt x xs  1"
  by (metis filter.simps(2) impossible_Cons linorder_class.linear list.set_intros(2)
      preorder_class.order_trans)
  with Cons.IH have "distinct xs" by auto
  moreover have "x  set xs" using Cons.prems
  proof (induction xs)
    case Nil then show ?case by auto
  next
    case (Cons a xs)
    from this(2) have "xaset (x # xs). cnt xa (x # a # xs)  1"
    by auto
    then have *: "xaset (x # xs). cnt xa (x # xs)  1"
    proof (safe, goal_cases)
      case (1 b)
      then have "cnt b (x # a # xs)  1" by auto
      with cnt_mono[of b x xs a] show ?case by fastforce
    qed
    with Cons(1) have "x  set xs" by auto
    moreover have "x  a"
    by (metis (full_types) Cons.prems One_nat_def * empty_iff filter.simps(2) impossible_Cons
                           le_0_eq le_Suc_eq length_0_conv list.set(1) list.set_intros(1)) 
    ultimately show ?case by auto
  qed
  ultimately show ?case by auto
qed

lemma remove_cycles_subs:
  "set (remove_cycles xs x ys)  set xs  set ys"
by (induction xs arbitrary: ys; auto; fastforce)

lemma start_remove_subs:
  "set (start_remove xs x ys)  set xs  set ys"
using remove_cycles_subs by (induction xs arbitrary: ys; auto; fastforce)

lemma remove_all_cycles_subs:
  "set (remove_all_cycles xs ys)  set ys"
using start_remove_subs by (induction xs arbitrary: ys, auto) (fastforce+)

lemma remove_all_cycles_distinct: "set ys  set xs  distinct (remove_all_cycles xs ys)"
proof -
  assume "set ys  set xs"
  hence " x  set ys. cnt x (remove_all_cycles xs ys)  1" using cnt_remove_all_cycles by fastforce
  hence " x  set (remove_all_cycles xs ys). cnt x (remove_all_cycles xs ys)  1"
  using remove_all_cycles_subs by fastforce
  thus "distinct (remove_all_cycles xs ys)" using cnt_distinct_intro by auto
qed

lemma distinct_remove_cycles_inv: "distinct (xs @ ys)  distinct (remove_cycles xs x ys)"
proof (induction xs arbitrary: ys)
  case Nil thus ?case by auto
next
  case (Cons y xs)
  thus ?case by auto
qed

definition "remove_all x xs = (if x  set xs then tl (remove_cycles xs x []) else xs)"

definition "remove_all_rev x xs = (if x  set xs then rev (tl (remove_cycles (rev xs) x [])) else xs)"

lemma remove_all_distinct:
  "distinct xs  distinct (x # remove_all x xs)"
proof (cases "x  set xs", goal_cases)
  case 1
  from remove_cycles_begins_with[OF 1(2), of "[]"] obtain zs
  where "remove_cycles xs x [] = x # zs" "x  set zs" by auto
  thus ?thesis using 1(1) distinct_remove_cycles_inv[of "xs" "[]" x] by (simp add: remove_all_def)
next
  case 2 thus ?thesis by (simp add: remove_all_def)
qed

lemma remove_all_removes:
  "x  set (remove_all x xs)"
by (metis list.sel(3) remove_all_def remove_cycles_begins_with)

lemma remove_all_subs:
  "set (remove_all x xs)  set xs"
using remove_cycles_subs remove_all_def
by (metis (no_types, lifting) append_Nil2 list.sel(2) list.set_sel(2) set_append subsetCE subsetI)

lemma remove_all_rev_distinct: "distinct xs  distinct (x # remove_all_rev x xs)"
proof (cases "x  set xs", goal_cases)
  case 1
  then have "x  set (rev xs)" by auto
  from remove_cycles_begins_with[OF this, of "[]"] obtain zs
  where "remove_cycles (rev xs) x [] = x # zs" "x  set zs" by auto
  thus ?thesis using 1(1) distinct_remove_cycles_inv[of "rev xs" "[]" x] by (simp add: remove_all_rev_def)
next
  case 2 thus ?thesis by (simp add: remove_all_rev_def)
qed

lemma remove_all_rev_removes: "x  set (remove_all_rev x xs)"
by (metis remove_all_def remove_all_removes remove_all_rev_def set_rev)

lemma remove_all_rev_subs: "set (remove_all_rev x xs)  set xs"
by (metis remove_all_def remove_all_subs set_rev remove_all_rev_def)

abbreviation "rem_cycles i j xs  remove_all i (remove_all_rev j (remove_all_cycles xs xs))"

lemma rem_cycles_distinct': "i  j  distinct (i # j # rem_cycles i j xs)"
proof -
  assume "i  j"
  have "distinct (remove_all_cycles xs xs)" by (simp add: remove_all_cycles_distinct)
  from remove_all_rev_distinct[OF this] have
    "distinct (remove_all_rev j (remove_all_cycles xs xs))"
  by simp
  from remove_all_distinct[OF this] have "distinct (i # rem_cycles i j xs)" by simp
  moreover have
    "j  set (rem_cycles i j xs)"
  using remove_all_subs remove_all_rev_removes remove_all_removes by fastforce
  ultimately show ?thesis by (simp add: i  j)
qed

lemma rem_cycles_removes_last: "j  set (rem_cycles i j xs)"
by (meson remove_all_rev_removes remove_all_subs rev_subsetD)

lemma rem_cycles_distinct: "distinct (rem_cycles i j xs)"
by (meson distinct.simps(2) order_refl remove_all_cycles_distinct
          remove_all_distinct remove_all_rev_distinct) 

lemma rem_cycles_subs: "set (rem_cycles i j xs)  set xs"
by (meson order_trans remove_all_cycles_subs remove_all_subs remove_all_rev_subs)

section ‹Definition of the Algorithm›

text ‹
  We formalize the Floyd-Warshall algorithm on a linearly ordered abelian semigroup.
  However, we would not need an abelian› monoid if we had the right type class.
›

class linordered_ab_monoid_add = linordered_ab_semigroup_add +
  fixes neutral :: 'a ("𝟭")
    assumes neutl[simp]: "𝟭 + x = x"
    assumes neutr[simp]: "x + 𝟭 = x"
begin

lemmas assoc = add.assoc

type_synonym 'c mat = "nat  nat  'c"

definition (in -) upd :: "'c mat  nat  nat  'c  'c mat"
where
  "upd m x y v = m (x := (m x) (y := v))"

definition fw_upd :: "'a mat  nat  nat  nat  'a mat" where
  "fw_upd m k i j  upd m i j (min (m i j) (m i k + m k j))"

lemma fw_upd_mono:
  "fw_upd m k i j i' j'  m i' j'" 
by (cases "i = i'", cases "j = j'") (auto simp: fw_upd_def upd_def)

fun fw :: "'a mat  nat  nat  nat  nat  'a mat" where
  "fw m n 0       0       0        = fw_upd m 0 0 0" |
  "fw m n (Suc k) 0       0        = fw_upd (fw m n k n n) (Suc k) 0 0" |
  "fw m n k       (Suc i) 0        = fw_upd (fw m n k i n) k (Suc i) 0" |
  "fw m n k       i       (Suc j)  = fw_upd (fw m n k i j) k i (Suc j)"

lemma fw_invariant_aux_1:
  "j''  j  i  n  j  n  k  n  fw m n k i j i' j'  fw m n k i j'' i' j'"
proof (induction j)
  case 0 thus ?case by simp
next
  case (Suc j) thus ?case
  proof (cases "j'' = Suc j")
    case True thus ?thesis by simp
  next
    case False
    have "fw_upd (fw m n k i j) k i (Suc j) i' j'  fw m n k i j i' j'" by (simp add: fw_upd_mono)
    thus ?thesis using Suc False by simp
  qed
qed

lemma fw_invariant_aux_2:
  "i  n  j  n  k  n  i''  i  j''  j
    fw m n k i j i' j'  fw m n k i'' j'' i' j'"
proof (induction i)
  case 0 thus ?case using fw_invariant_aux_1 by auto
next
  case (Suc i) thus ?case
  proof (cases "i'' = Suc i")
    case True thus ?thesis using Suc fw_invariant_aux_1 by simp
  next
    case False
    have "fw m n k (Suc i) j i' j'  fw m n k (Suc i) 0 i' j'"
    using fw_invariant_aux_1[of 0 j "Suc i" n k] Suc(2-) by simp
    also have "  fw m n k i n i' j'" by (simp add: fw_upd_mono)
    also have "  fw m n k i j i' j'" using fw_invariant_aux_1[of j n i n k] False Suc by simp
    also have "  fw m n k i'' j'' i' j'" using Suc False by simp
    finally show ?thesis by simp
  qed
qed

lemma fw_invariant:
  "k'  k  i  n  j  n  k  n  j''  j  i''  i
    fw m n k i j i' j'  fw m n k' i'' j'' i' j'"
proof (induction k)
  case 0 thus ?case using fw_invariant_aux_2 by auto
next
  case (Suc k) thus ?case
  proof (cases "k' = Suc k")
    case True thus ?thesis using Suc fw_invariant_aux_2 by simp
  next
    case False
    have "fw m n (Suc k) i j i' j'  fw m n (Suc k) 0 0 i' j'"
    using fw_invariant_aux_2[of i n j "Suc k" 0 0] Suc(2-) by simp
    also have "  fw m n k n n i' j'" by (simp add: fw_upd_mono)
    also have "  fw m n k i j i' j'" using fw_invariant_aux_2[of n n n k] False Suc by simp
    also have "  fw m n k' i'' j'' i' j'" using Suc False by simp
    finally show ?thesis by simp
  qed
qed

lemma single_row_inv:
  "j' < j  j  n  i'  n  fw m n k i' j i' j' = fw m n k i' j' i' j'"
proof (induction j)
  case 0 thus ?case by simp
next
  case (Suc j) thus ?case by (cases "j' = j") (simp add: fw_upd_def upd_def)+
qed

lemma single_iteration_inv':
  "i' < i  j'  n  j  n  i  n  fw m n k i j i' j' = fw m n k i' j' i' j'"
proof (induction i arbitrary: j)
  case 0 thus ?case by simp
next
  case (Suc i) thus ?case
  proof (induction j)
    case 0 thus ?case
    proof (cases "i = i'", goal_cases)
      case 2 thus ?case by (simp add: fw_upd_def upd_def)
    next
      case 1 thus ?case using single_row_inv[of j' n n i' m k] 
      by (cases "j' = n") (fastforce simp add: fw_upd_def upd_def)+
    qed
  next
    case (Suc j) thus ?case by (simp add: fw_upd_def upd_def)
  qed
qed

lemma single_iteration_inv:
  "i'  i  j'  j  i  n  j  n fw m n k i j i' j' = fw m n k i' j' i' j'"
proof (induction i arbitrary: j)
  case 0 thus ?case
  proof (induction j)
    case 0 thus ?case by simp
  next
    case (Suc j) thus ?case using 0 by (cases "j' = Suc j") (simp add: fw_upd_def upd_def)+
  qed
next
  case (Suc i) thus ?case
  proof (induction j)
    case 0 thus ?case by (cases "i' = Suc i") (simp add: fw_upd_def upd_def)+
  next
    case (Suc j) thus ?case
    proof (cases "i' = Suc i", goal_cases)
      case 1 thus ?case
      proof (cases "j' = Suc j", goal_cases)
        case 1 thus ?case by simp
      next
        case 2 thus ?case by (simp add: fw_upd_def upd_def)
      qed
    next
      case 2 thus ?case
      proof (cases "j' = Suc j", goal_cases)
        case 1 thus ?case using single_iteration_inv'[of i' "Suc i" j' n "Suc j" m k] by simp
      next
        case 2 thus ?case by (simp add: fw_upd_def upd_def)
      qed
    qed
  qed
qed

lemma fw_innermost_id:
  "i  n  j  n  j'  n  i' < i  fw m n 0 i' j' i j = m i j"
proof (induction i' arbitrary: j')
  case 0 thus ?case
  proof (induction j')
    case 0 thus ?case by (simp add: fw_upd_def upd_def)
  next
    case (Suc j') thus ?case by (auto simp: fw_upd_def upd_def)
  qed
next
  case (Suc i') thus ?case
  proof (induction j')
    case 0 thus ?case by (auto simp add: fw_upd_def upd_def)
  next
    case (Suc j') thus ?case by (auto simp add: fw_upd_def upd_def)
  qed
qed

lemma fw_middle_id:
  "i  n  j  n  j' < j  i'  i  fw m n 0 i' j' i j = m i j"
proof (induction i' arbitrary: j')
  case 0 thus ?case
  proof (induction j')
    case 0 thus ?case by (simp add: fw_upd_def upd_def)
  next
    case (Suc j') thus ?case by (auto simp: fw_upd_def upd_def)
  qed
next
  case (Suc i') thus ?case
  proof (induction j')
    case 0 thus ?case using fw_innermost_id by (auto simp add: fw_upd_def upd_def)
  next
    case (Suc j') thus ?case by (auto simp add: fw_upd_def upd_def)
  qed
qed

lemma fw_outermost_mono:
  "i  n  j  n  fw m n 0 i j i j  m i j"
proof (cases j)
  case 0
  assume "i  n"
  thus ?thesis
  proof (cases i)
    case 0 thus ?thesis using j = 0 by (simp add: fw_upd_def upd_def)
  next
    case (Suc i')
    hence "fw m n 0 i' n (Suc i') 0 = m (Suc i') 0" using fw_innermost_id[of "Suc i'" n 0 n i' m]
    using i  n by simp
    thus ?thesis using j = 0 Suc by (simp add: fw_upd_def upd_def)
  qed
next
  case (Suc j')
  assume "i  n" "j  n"
  hence "fw m n 0 i j' i (Suc j') = m i (Suc j')"
  using fw_middle_id[of i n "Suc j'" j' i m] Suc by simp
  thus ?thesis using Suc by (simp add: fw_upd_def upd_def)
qed

lemma Suc_innermost_id1:
  "i  n  j  n  j'  n  i' < i  fw m n (Suc k) i' j' i j = fw m n k i j i j"
proof (induction i' arbitrary: j')
  case 0 thus ?case
  proof (induction j')
    case 0
    hence "fw m n k n n i j = fw m n k i j i j" using single_iteration_inv[of i n j n n m k] by simp
    thus ?case using 0 by (simp add: fw_upd_def upd_def)
  next
    case (Suc j') thus ?case by (auto simp: fw_upd_def upd_def)
  qed
next
  case (Suc i') thus ?case
  proof (induction j')
    case 0 thus ?case by (auto simp add: fw_upd_def upd_def)
  next
    case (Suc j') thus ?case by (auto simp add: fw_upd_def upd_def)
  qed
qed

lemma Suc_innermost_id2:
  "i  n  j  n  j' < j  i'  i  fw m n (Suc k) i' j' i j = fw m n k i j i j"
proof (induction i' arbitrary: j')
  case 0
  hence "fw m n k n n i j = fw m n k i j i j" using single_iteration_inv[of i n j n n m k] by simp
  with 0 show ?case
  proof (induction j')
    case 0
    thus ?case by (auto simp add: fw_upd_def upd_def)
  next
    case (Suc j') thus ?case by (auto simp: fw_upd_def upd_def)
  qed
next
  case (Suc i') thus ?case
  proof (induction j')
    case 0 thus ?case using Suc_innermost_id1 by (auto simp add: fw_upd_def upd_def)
  next
    case (Suc j') thus ?case by (auto simp add: fw_upd_def upd_def)
  qed
qed

lemma Suc_innermost_id1':
  "i  n  j  n  j'  n  i' < i  fw m n (Suc k) i' j' i j = fw m n k n n i j"
proof goal_cases
  case 1
  hence "fw m n (Suc k) i' j' i j = fw m n k i j i j" using Suc_innermost_id1 by simp
  thus ?thesis using 1 single_iteration_inv[of i n] by simp
qed

lemma Suc_innermost_id2':
  "i  n  j  n  j' < j  i'  i  fw m n (Suc k) i' j' i j = fw m n k n n i j"
proof goal_cases
  case 1
  hence "fw m n (Suc k) i' j' i j = fw m n k i j i j" using Suc_innermost_id2 by simp
  thus ?thesis using 1 single_iteration_inv[of i n] by simp
qed

lemma Suc_innermost_mono:
  "i  n  j  n  fw m n (Suc k) i j i j  fw m n k i j i j"
proof (cases j)
  case 0
  assume "i  n"
  thus ?thesis
  proof (cases i)
    case 0 thus ?thesis using j = 0 single_iteration_inv[of 0 n 0 n n m k]
    by (simp add: fw_upd_def upd_def)
  next
    case (Suc i')
    thus ?thesis using Suc_innermost_id1 i  n j = 0
    by (auto simp: fw_upd_def upd_def local.min.coboundedI1)
  qed
next
  case (Suc j')
  assume "i  n" "j  n"
  thus ?thesis using Suc Suc_innermost_id2 by (auto simp: fw_upd_def upd_def local.min.coboundedI1)
qed

lemma fw_mono':
  "i  n  j  n  fw m n k i j i j  m i j"
proof (induction k)
  case 0 thus ?case using fw_outermost_mono by simp
next
  case (Suc k) thus ?case using Suc_innermost_mono[OF Suc.prems, of m k] by simp
qed

lemma fw_mono:
  "i  n  j  n  i'  n  j'  n  fw m n k i j i' j'  m i' j'"
proof (cases k)
  case 0
  assume 0: "i  n" "j  n" "i'  n" "j'  n" "k = 0"
  thus ?thesis
  proof (cases "i'  i")
    case False thus ?thesis using 0 fw_innermost_id by simp
  next
    case True thus ?thesis
    proof (cases "j'  j")
      case True
      have "fw m n 0 i j i' j'  fw m n 0 i' j' i' j'" using fw_invariant True i'  i 0 by simp
      also have "fw m n 0 i' j' i' j'  m i' j'" using 0 fw_outermost_mono by blast
      finally show ?thesis by (simp add: k = 0)
    next
      case False thus ?thesis
      proof (cases "i = i'", goal_cases)
        case 1 then show ?thesis using fw_middle_id[of i' n j' j i' m] 0 by simp
      next
        case 2
        then show ?case
        using single_iteration_inv'[of i' i j' n j m 0] i'  i fw_middle_id[of i' n j' j i' m]
              fw_outermost_mono[of i' n j' m] 0
        by simp
      qed
    qed
  qed
next
  case (Suc k)
  assume prems: "i  n" "j  n" "i'  n" "j'  n"
  thus ?thesis
  proof (cases "i'  i  j'  j")
    case True
    hence "fw m n (Suc k) i j i' j' = fw m n (Suc k) i' j' i' j'"
    using prems single_iteration_inv by blast
    thus ?thesis using Suc prems fw_mono' by auto
  next
    case False thus ?thesis
    proof auto
      assume "¬ i'  i"
      thus ?thesis using Suc prems fw_mono' Suc_innermost_id1 by auto
    next
      assume "¬ j'  j"
      hence "j < j'" by simp
      show ?thesis
      proof (cases "i  i'")
        case True
        thus ?thesis using Suc prems Suc_innermost_id2 j < j' fw_mono' by auto
      next
        case False
        thus ?thesis using single_iteration_inv' Suc prems fw_mono' by auto
      qed
    qed
  qed
qed

lemma add_mono_neutr:
  assumes "𝟭  b"
  shows "a  a + b"
using neutr add_mono assms by force

lemma add_mono_neutl:
  assumes "𝟭  b"
  shows "a  b + a"
using neutr add_mono assms by force

lemma fw_step_0:
  "m 0 0  𝟭  i  n  j  n  fw m n 0 i j i j = min (m i j) (m i 0 + m 0 j)"
proof (induction i)
  case 0 thus ?case
  proof (cases j)
    case 0 thus ?thesis by (simp add: fw_upd_def upd_def)
  next
    case (Suc j)
    hence "fw m n 0 0 j 0 (Suc j) = m 0 (Suc j)" using 0 fw_middle_id[of 0 n "Suc j" j 0 m] by fast
    moreover have "fw m n 0 0 j 0 0 = m 0 0" using single_iteration_inv[of 0 0 0 j n m 0] Suc 0
    by (auto simp add: fw_upd_def upd_def min_def intro: add_mono_neutl)
    ultimately show ?thesis using Suc by (simp add: fw_upd_def upd_def)
  qed
next
  case (Suc i)
  note A = this
  show ?case
  proof (cases j)
    case 0
    have "fw m n 0 i n (Suc i) 0 = m (Suc i) 0" using fw_innermost_id[of "Suc i" n 0 n i m] Suc by simp
    moreover have "fw m n 0 i n 0 0 = m 0 0" using Suc single_iteration_inv[of 0 i 0 n n m 0]
    by (auto simp add: fw_upd_def upd_def min_def intro: add_mono_neutl)
    ultimately show ?thesis using 0 by (simp add: fw_upd_def upd_def)
  next
    case (Suc j)
    have *: "fw m n 0 0 j 0 0 = m 0 0" using single_iteration_inv[ of 0 0 0 j n m 0] A Suc
    by (auto simp add: fw_upd_def upd_def min_def intro: add_mono_neutl)
    have **: "fw m n 0 i n 0 0 = m 0 0" using single_iteration_inv[of 0 i 0 n n m 0] A
    by (auto simp add: fw_upd_def upd_def min_def intro: add_mono_neutl)
    have "m 0 (Suc j) = fw_upd m 0 0 (Suc j) 0 (Suc j)" using m 0 0 >= 𝟭
    by (auto simp add: fw_upd_def upd_def min_def intro: add_mono_neutl)
    also have " = fw m n 0 0 (Suc j) 0 (Suc j)" using fw_middle_id[of 0 n "Suc j" j 0 m] Suc A(4)
    by (simp add: fw_upd_def upd_def *)
    finally have ***: "fw m n 0 (Suc i) j 0 (Suc j) = m 0 (Suc j)"
    using single_iteration_inv'[of 0 "Suc i" "Suc j" n j m 0] A Suc by simp
    have "m (Suc i) 0 = fw_upd m 0 (Suc i) 0 (Suc i) 0" using m 0 0 >= 𝟭
    by (auto simp add: fw_upd_def upd_def min_def intro: add_mono_neutr)
    also have " = fw m n 0 (Suc i) 0 (Suc i) 0"
    using fw_innermost_id[of "Suc i" n 0 n i m] ‹Suc i  n ** by (simp add: fw_upd_def upd_def)
    finally have "fw m n 0 (Suc i) j (Suc i) 0 = m (Suc i) 0"
    using single_iteration_inv A Suc by auto
    moreover have "fw m n 0 (Suc i) j (Suc i) (Suc j) = m (Suc i) (Suc j)"
    using fw_middle_id A Suc by simp
    ultimately show ?thesis using Suc *** by (simp add: fw_upd_def upd_def)
  qed
qed

lemma fw_step_Suc:
  " k'n. fw m n k n n k' k'  𝟭  i  n  j  n  Suc k  n
     fw m n (Suc k) i j i j = min (fw m n k n n i j) (fw m n k n n i (Suc k) + fw m n k n n (Suc k) j)"
proof (induction i)
  case 0 thus ?case
  proof (cases j)
    case 0 thus ?thesis by (simp add: fw_upd_def upd_def)
  next
    case (Suc j)
    then have
      "fw m n k n n 0 (Suc j) = fw m n (Suc k) 0 j 0 (Suc j)"
    using 0(2-) Suc_innermost_id2' by simp
    moreover have "fw m n (Suc k) 0 j 0 (Suc k) = fw m n k n n 0 (Suc k)"
    proof (cases "j < Suc k")
      case True thus ?thesis using 0 Suc_innermost_id2' by simp
    next
      case False
      hence
        "fw m n (Suc k) 0 k 0 (Suc k) = fw m n k n n 0 (Suc k)"
      using 0(2-) Suc Suc_innermost_id2' by simp
      moreover have "fw m n (Suc k) 0 k (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
      using 0(2-) Suc Suc_innermost_id2' by simp
      moreover have "fw m n (Suc k) 0 j 0 (Suc k) = fw m n (Suc k) 0 (Suc k) 0 (Suc k)"
      using False single_iteration_inv 0(2-) Suc by force
      ultimately show ?thesis using 0(1)
      by (auto simp add: fw_upd_def upd_def ‹Suc k  n min_def intro: add_mono_neutr)
    qed
    moreover have "fw m n k n n (Suc k) (Suc j) = fw m n (Suc k) 0 j (Suc k) (Suc j)"
    using 0(2-) Suc Suc_innermost_id2' by simp
    ultimately show ?thesis using Suc by (simp add: fw_upd_def upd_def)
  qed
next
  case (Suc i)
  note A = this
  show ?case
  proof (cases j)
    case 0
    hence
      "fw m n (Suc k) i n (Suc i) 0 = fw m n k n n (Suc i) 0"
    using Suc_innermost_id1' ‹Suc i  n by simp
    moreover have "fw m n (Suc k) i n (Suc i) (Suc k) = fw m n k n n (Suc i) (Suc k)"
    using Suc_innermost_id1' A(3,5) by simp
    moreover have "fw m n (Suc k) i n (Suc k) 0 = fw m n k n n (Suc k) 0"
    proof (cases "i < Suc k")
      case True thus ?thesis using Suc_innermost_id1' A(3,5) by simp
    next
      case False
      have "fw m n (Suc k) k n (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
      using Suc_innermost_id1' ‹Suc i  n False by simp
      moreover have "fw m n (Suc k) k n (Suc k) 0 = fw m n k n n (Suc k) 0"
      using Suc_innermost_id1' ‹Suc i  n False by simp
      moreover have "fw m n (Suc k) i n (Suc k) 0 = fw m n (Suc k) (Suc k) 0 (Suc k) 0"
      using single_iteration_inv ‹Suc i  n False by simp
      ultimately show ?thesis using Suc(2)
      by (auto simp add: fw_upd_def upd_def ‹Suc k  n min_def intro: add_mono_neutl)
    qed
    ultimately show ?thesis using 0 by (simp add: fw_upd_def upd_def)
  next
    case (Suc j)
    hence "fw m n (Suc k) (Suc i) j (Suc i) (Suc j) = fw m n k n n (Suc i) (Suc j)"
    using Suc_innermost_id2' A(3,4) by simp
    moreover have "fw m n (Suc k) (Suc i) j (Suc i) (Suc k) = fw m n k n n (Suc i) (Suc k)"
    proof (cases "j < Suc k")
      case True thus ?thesis using Suc A(3-) Suc_innermost_id2' by simp
    next
      case False
      have *:"fw m n (Suc k) (Suc i) k (Suc i) (Suc k) = fw m n k n n (Suc i) (Suc k)"
      using Suc_innermost_id2' A(3,5) by simp
      have **:"fw m n (Suc k) (Suc i) k (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
      proof (cases "Suc i  Suc k")
        case True thus ?thesis using Suc_innermost_id2' A(5) by simp
      next
        case False
        hence "fw m n (Suc k) (Suc i) k (Suc k) (Suc k) = fw m n (Suc k) (Suc k) (Suc k) (Suc k) (Suc k)"
        using single_iteration_inv'[of "Suc k" "Suc i" "Suc k" n k m "Suc k"] A(3) by simp
        moreover have "fw m n (Suc k) (Suc k) k (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
        using Suc_innermost_id2' A(5) by simp
        ultimately show ?thesis using A(2)
        by (auto simp add: fw_upd_def upd_def ‹Suc k  n min_def intro: add_mono_neutl)
      qed
      have "fw m n (Suc k) (Suc i) j (Suc i) (Suc k) = fw m n (Suc k) (Suc i) (Suc k) (Suc i) (Suc k)"
      using False single_iteration_inv[of "Suc i" "Suc i" "Suc k" j n m "Suc k"] A(3-) Suc by simp
      also have " = fw m n k n n (Suc i) (Suc k)" using * ** A(2)
      by (auto simp add: fw_upd_def upd_def ‹Suc k  n min_def intro: add_mono_neutr)
      finally show ?thesis by simp
    qed
    moreover have "fw m n (Suc k) (Suc i) j (Suc k) (Suc j) = fw m n k n n (Suc k) (Suc j)"
    proof (cases "Suc i  Suc k")
      case True thus ?thesis using Suc_innermost_id2' Suc A(3-5) by simp
    next
      case False
      have "fw m n (Suc k) (Suc k) j (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
      proof (cases "j < Suc k")
        case True thus ?thesis using Suc_innermost_id2' A(5) by simp
      next
        case False
        hence "fw m n (Suc k) (Suc k) j (Suc k) (Suc k) = fw m n (Suc k) (Suc k) (Suc k) (Suc k) (Suc k)"
        using single_iteration_inv A(3,4) Suc by simp
        moreover have "fw m n (Suc k) (Suc k) k (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
        using Suc_innermost_id2' A(5) by simp
        ultimately show ?thesis using A(2)
        by (auto simp add: fw_upd_def upd_def ‹Suc k  n min_def intro: add_mono_neutl)
      qed
      moreover have "fw m n (Suc k) (Suc k) j (Suc k) (Suc j) = fw m n k n n (Suc k) (Suc j)"
      using Suc_innermost_id2' Suc A(3-5) by simp
      ultimately have "fw m n (Suc k) (Suc k) (Suc j) (Suc k) (Suc j) = fw m n k n n (Suc k) (Suc j)"
      using A(2) by (auto simp add: fw_upd_def upd_def ‹Suc k  n min_def intro: add_mono_neutl)
      moreover have "fw m n (Suc k) (Suc i) j (Suc k) (Suc j) = fw m n (Suc k) (Suc k) (Suc j) (Suc k) (Suc j)"
      using single_iteration_inv'[of "Suc k" "Suc i" "Suc j" n j m "Suc k"] Suc A(3-) False  by simp
      moreover have "fw m n (Suc k) (Suc k) k (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
      using Suc_innermost_id2' A(5) by simp
      ultimately show ?thesis using A(2) by (simp add: fw_upd_def upd_def)
    qed
    ultimately show ?thesis using Suc by (simp add: fw_upd_def upd_def)
  qed
qed


subsection ‹Length of Paths›

fun len :: "'a mat  nat  nat  nat list  'a" where
  "len m u v [] = m u v" |
  "len m u v (w#ws) = m u w + len m w v ws"

lemma len_decomp: "xs = ys @ y # zs  len m x z xs = len m x y ys + len m y z zs"
by (induction ys arbitrary: x xs) (simp add: assoc)+

lemma len_comp: "len m a c (xs @ b # ys) = len m a b xs + len m b c ys"
by (induction xs arbitrary: a) (auto simp: assoc)


subsection ‹Shortening Negative Cycles›

lemma remove_cycles_neg_cycles_aux:
  fixes i xs ys
  defines "xs'  i # ys"
  assumes "i  set ys"
  assumes "i  set xs"
  assumes "xs = as @ concat (map ((#) i) xss) @ xs'"
  assumes "len m i j ys > len m i j xs"
  shows " ys. set ys  set xs  len m i i ys < 𝟭" using assms
proof (induction xss arbitrary: xs as)
  case Nil
  with Nil show ?case
  proof (cases "len m i i as  𝟭", goal_cases)
    case 1
    from this(4,6) len_decomp[of xs as i ys m i j]
    have "len m i j xs = len m i i as + len m i j ys" by simp
    with 1(11)
    have "len m i j ys  len m i j xs" using add_mono by fastforce
    thus ?thesis using Nil(5) by auto
  next
    case 2 thus ?case by auto
  qed
next
  case (Cons zs xss)
  let ?xs = "zs @ concat (map ((#) i) xss) @ xs'"
  from Cons show ?case
  proof (cases "len m i i as  𝟭", goal_cases)
    case 1
    from this(5,7) len_decomp add_mono
    have "len m i j ?xs  len m i j xs" by fastforce
    hence 4:"len m i j ?xs < len m i j ys" using 1(6) by simp
    have 2:"i  set ?xs" using Cons(2) by auto
    have "set ?xs  set xs" using Cons(5) by auto
    moreover from Cons(1)[OF 1(2,3) 2 _ 4] have "ys. set ys  set ?xs  len m i i ys < 𝟭" by auto
    ultimately show ?case by blast
  next
    case 2
    from this(5,7) show ?case by auto
  qed
qed

lemma add_lt_neutral: "a + b < b  a < 𝟭"
proof (rule ccontr)
  assume "a + b < b" "¬ a < 𝟭"
  hence "a  𝟭" by auto
  from add_mono[OF this, of b b] a + b < b show False by auto
qed

lemma remove_cycles_neg_cycles_aux':
  fixes j xs ys
  assumes "j  set ys"
  assumes "j  set xs"
  assumes "xs = ys @ j # concat (map (λ xs. xs @ [j]) xss) @ as"
  assumes "len m i j ys > len m i j xs"
  shows " ys. set ys  set xs  len m j j ys < 𝟭" using assms
proof (induction xss arbitrary: xs as)
  case Nil
  show ?case
  proof (cases "len m j j as  𝟭")
    case True
    from Nil(3) len_decomp[of xs ys j as m i j]
    have "len m i j xs = len m i j ys + len m j j as" by simp
    with True
    have "len m i j ys  len m i j xs" using add_mono by fastforce
    with Nil show ?thesis by auto
  next
    case False with Nil show ?thesis by auto
  qed
next
  case (Cons zs xss)
  let ?xs = "ys @ j # concat (map (λxs. xs @ [j]) xss) @ as"
  let ?t = "concat (map (λxs. xs @ [j]) xss) @ as"
  show ?case
  proof (cases "len m i j ?xs  len m i j xs")
    case True
    hence 4:"len m i j ?xs < len m i j ys" using Cons(5) by simp
    have 2:"j  set ?xs" using Cons(2) by auto
    have "set ?xs  set xs" using Cons(4) by auto
    moreover from Cons(1)[OF Cons(2) 2 _ 4] have "ys. set ys  set ?xs  len m j j ys < 𝟭" by blast
    ultimately show ?thesis by blast
  next
    case False
    hence "len m i j xs < len m i j ?xs" by auto
    from this len_decomp Cons(4) add_mono
    have "len m j j (concat (map (λxs. xs @ [j]) (zs # xss)) @ as) < len m j j ?t"
    using False local.leI by fastforce 
    hence "len m j j (zs @ j # ?t) < len m j j ?t" by simp
    with len_decomp[of "zs @ j # ?t" zs j ?t m j j]
    have "len m j j zs + len m j j ?t < len m j j ?t" by auto
    hence "len m j j zs < 𝟭" using add_lt_neutral by auto
    thus ?thesis using Cons.prems(3) by auto
  qed
qed

lemma add_le_impl: "a + b < a + c  b < c"
proof (rule ccontr)
  assume "a + b < a + c" "¬ b < c"
  hence "b  c" by auto
  from add_mono[OF _ this, of a a] a + b < a + c show False by auto
qed

lemma start_remove_neg_cycles:
  "len m i j (start_remove xs k []) > len m i j xs   ys. set ys  set xs  len m k k ys < 𝟭"
proof-
  let ?xs = "start_remove xs k []"
  assume len_lt:"len m i j ?xs > len m i j xs"
  hence "k  set xs" using start_remove_id by fastforce
  from start_remove_decomp[OF this, of "[]"] obtain as bs where as_bs:
    "xs = as @ k # bs" "?xs = as @ remove_cycles bs k [k]"
  by fastforce
  let ?xs' = "remove_cycles bs k [k]"
  have "k  set bs" using as_bs len_lt remove_cycles_id by fastforce
  then obtain ys where ys: "?xs = as @ k # ys" "?xs' = k # ys" "k  set ys"
  using as_bs(2) remove_cycles_begins_with[OF k  set bs] by auto
  have len_lt': "len m k j bs < len m k j ys"
  using len_decomp[OF as_bs(1), of m i j] len_decomp[OF ys(1), of m i j] len_lt add_le_impl by metis
  from remove_cycles_cycles[OF k  set bs] obtain xss as'
  where "as' @ concat (map ((#) k) xss) @ ?xs' = bs" by fastforce
  hence "as' @ concat (map ((#) k) xss) @ k # ys = bs" using ys(2) by simp
  from remove_cycles_neg_cycles_aux[OF k  set ys k  set bs this[symmetric] len_lt']
  show ?thesis using as_bs(1) by auto
qed

lemma remove_all_cycles_neg_cycles:
  "len m i j (remove_all_cycles ys xs) > len m i j xs
    ys k. set ys  set xs  k  set xs  len m k k ys < 𝟭"
proof (induction ys arbitrary: xs)
  case Nil thus ?case by auto
next
  case (Cons y ys)
  let ?xs = "start_remove xs y []"
  show ?case
  proof (cases "len m i j xs < len m i j ?xs")
    case True
    with start_remove_id have "y  set xs" by fastforce
    with start_remove_neg_cycles[OF True] show ?thesis by blast
  next
    case False
    with Cons(2) have "len m i j ?xs < len m i j (remove_all_cycles (y # ys) xs)" by auto
    hence "len m i j ?xs < len m i j (remove_all_cycles ys ?xs)" by auto
    from Cons(1)[OF this] show ?thesis using start_remove_subs[of xs y "[]"] by auto
  qed
qed

lemma (in -) concat_map_cons_rev:
  "rev (concat (map ((#) j) xss)) = concat (map (λ xs. xs @ [j]) (rev (map rev xss)))"
by (induction xss) auto

lemma negative_cycle_dest: "len m i j (rem_cycles i j xs) > len m i j xs
         i' ys. len m i' i' ys < 𝟭  set ys  set xs  i'  set (i # j # xs)"
proof -
  let ?xsij = "rem_cycles i j xs"
  let ?xsj  = "remove_all_rev j (remove_all_cycles xs xs)"
  let ?xs   = "remove_all_cycles xs xs"
  assume len_lt: "len m i j ?xsij > len m i j xs"
  show ?thesis
  proof (cases "len m i j ?xsij  len m i j ?xsj")
    case True
    hence len_lt: "len m i j ?xsj > len m i j xs" using len_lt by simp
    show ?thesis
    proof (cases "len m i j ?xsj  len m i j ?xs")
      case True
      hence "len m i j ?xs > len m i j xs" using len_lt by simp
      with remove_all_cycles_neg_cycles[OF this] show ?thesis by auto
    next
      case False
      then have len_lt': "len m i j ?xsj > len m i j ?xs" by simp
      show ?thesis
      proof (cases "j  set ?xs")
        case False
        thus ?thesis using len_lt' by (simp add: remove_all_rev_def)
      next
        case True
          from remove_all_rev_removes[of j] have 1: "j  set ?xsj" by simp
          from True have "j  set (rev ?xs)" by auto
          from remove_cycles_cycles[OF this] obtain xss as where as:
          "as @ concat (map ((#) j) xss) @ remove_cycles (rev ?xs) j [] = rev ?xs" "j  set as"
          by blast
          from True have "?xsj = rev (tl (remove_cycles (rev ?xs) j []))" by (simp add: remove_all_rev_def)
          with remove_cycles_begins_with[OF j  set (rev ?xs), of "[]"]
          have "remove_cycles (rev ?xs) j [] = j # rev ?xsj" "j  set ?xsj"
          by auto
          with as(1) have xss: "as @ concat (map ((#) j) xss) @ j # rev ?xsj = rev ?xs" by simp
          hence "rev (as @ concat (map ((#) j) xss) @ j # rev ?xsj) = ?xs" by simp
          hence "?xsj @ j # rev (concat (map ((#) j) xss)) @ rev as = ?xs" by simp
          hence "?xsj @ j # concat (map (λ xs. xs @ [j]) (rev (map rev xss))) @ rev as = ?xs"
          by (simp add: concat_map_cons_rev)
          from remove_cycles_neg_cycles_aux'[OF 1 True this[symmetric] len_lt']
          show ?thesis using remove_all_cycles_subs by fastforce
      qed
    qed
  next
    case False
    hence len_lt': "len m i j ?xsij > len m i j ?xsj" by simp
    show ?thesis
    proof (cases "i  set ?xsj")
      case False
      thus ?thesis using len_lt' by (simp add: remove_all_def)
    next
      case True
      from remove_all_removes[of i] have 1: "i  set ?xsij" by (simp add: remove_all_def)
      from remove_cycles_cycles[OF True] obtain xss as where as:
      "as @ concat (map ((#) i) xss) @ remove_cycles ?xsj i [] = ?xsj" "i  set as" by blast
      from True have "?xsij = tl (remove_cycles ?xsj i [])" by (simp add: remove_all_def)
      with remove_cycles_begins_with[OF True, of "[]"]
      have "remove_cycles ?xsj i [] = i # ?xsij" "i  set ?xsij"
      by auto
      with as(1) have xss: "as @ concat (map ((#) i) xss) @ i # ?xsij = ?xsj" by simp
      from remove_cycles_neg_cycles_aux[OF 1 True this[symmetric] len_lt']
      show ?thesis using remove_all_rev_subs remove_all_cycles_subs by fastforce
    qed
  qed
qed

section ‹Definition of Shortest Paths›

definition D :: "'a mat  nat  nat  nat  'a" where
  "D m i j k  Min {len m i j xs | xs. set xs  {0..k}  i  set xs  j  set xs  distinct xs}"

lemma (in -) distinct_length_le:"finite s  set xs  s  distinct xs  length xs  card s"
by (metis card_mono distinct_card) 

lemma (in -) finite_distinct: "finite s  finite {xs . set xs  s  distinct xs}"
proof -
  assume "finite s"
  hence "{xs . set xs  s  distinct xs}  {xs. set xs  s  length xs  card s}"
  using distinct_length_le by auto
  moreover have "finite {xs. set xs  s  length xs  card s}"
  using finite_lists_length_le[OF ‹finite s] by auto
  ultimately show ?thesis by (rule finite_subset)
qed

lemma D_base_finite:
  "finite {len m i j xs | xs. set xs  {0..k}  distinct xs}"
using finite_distinct finite_image_set by blast

lemma D_base_finite':
  "finite {len m i j xs | xs. set xs  {0..k}  distinct (i # j # xs)}"
proof -
  have "{len m i j xs | xs. set xs  {0..k}  distinct (i # j # xs)}
         {len m i j xs | xs. set xs  {0..k}  distinct xs}" by auto
  with D_base_finite[of m i j k] show ?thesis by (rule rev_finite_subset)
qed

lemma D_base_finite'':
  "finite {len m i j xs |xs. set xs  {0..k}  i  set xs  j  set xs  distinct xs}"
using D_base_finite[of m i j k] by - (rule finite_subset, auto)

definition cycle_free :: "'a mat  nat  bool" where
  "cycle_free m n   i xs. i  n  set xs  {0..n} 
  ( j. j  n  len m i j (rem_cycles i j xs)  len m i j xs)  len m i i xs  𝟭"

lemma D_eqI:
  fixes m n i j k
  defines "A  {len m i j xs | xs. set xs  {0..k}}"
  defines "A_distinct  {len m i j xs |xs. set xs  {0..k}  i  set xs  j  set xs  distinct xs}"
  assumes "cycle_free m n" "i  n" "j  n" "k  n" "(y. y  A_distinct  x  y)" "x  A"
  shows "D m i j k = x" using assms
proof -
  let ?S = "{len m i j xs |xs. set xs  {0..k}  i  set xs  j  set xs  distinct xs}"
  show ?thesis unfolding D_def
  proof (rule Min_eqI)
    have "?S  {len m i j xs |xs. set xs  {0..k}  distinct xs}" by auto
    thus "finite {len m i j xs |xs. set xs  {0..k}  i  set xs  j  set xs  distinct xs}"
    using D_base_finite[of m i j k] by (rule finite_subset)
  next
    fix y assume "y  ?S"
    hence "y  A_distinct" using assms(2,7) by fastforce
    thus "x  y" using assms by meson
  next
    from assms obtain xs where xs: "x = len m i j xs" "set xs  {0..k}" by auto
    let ?ys = "rem_cycles i j xs"
    let ?y = "len m i j ?ys"
    from assms(3-6) xs have *:"?y  x" by (fastforce simp add: cycle_free_def)
    have distinct: "i  set ?ys" "j  set ?ys" "distinct ?ys"
    using rem_cycles_distinct remove_all_removes rem_cycles_removes_last by fast+
    with xs(2) have "?y  A_distinct" unfolding A_distinct_def using rem_cycles_subs by fastforce
    hence "x  ?y" using assms by meson
    moreover have "?y  x" using assms(3-6) xs by (fastforce simp add: cycle_free_def)
    ultimately have "x = ?y" by simp
    thus "x  ?S" using distinct xs(2) rem_cycles_subs[of i j xs] by fastforce
  qed
qed

lemma D_base_not_empty:
   "{len m i j xs |xs. set xs  {0..k}  i  set xs  j  set xs  distinct xs}  {}"
proof -
  have "len m i j []  {len m i j xs |xs. set xs  {0..k}  i  set xs  j  set xs  distinct xs}"
  by fastforce
  thus ?thesis by auto
qed

lemma Min_elem_dest: "finite A  A  {}  x = Min A  x  A" by simp

lemma D_dest: "x = D m i j k 
  x  {len m i j xs |xs. set xs  {0..Suc k}  i  set xs  j  set xs  distinct xs}"
using Min_elem_dest[OF D_base_finite'' D_base_not_empty] by (fastforce simp add: D_def)

lemma D_dest': "x = D m i j k  x  {len m i j xs |xs. set xs  {0..Suc k}}"
using Min_elem_dest[OF D_base_finite'' D_base_not_empty] by (fastforce simp add: D_def)

lemma D_dest'': "x = D m i j k  x  {len m i j xs |xs. set xs  {0..k}}"
using Min_elem_dest[OF D_base_finite'' D_base_not_empty] by (fastforce simp add: D_def)

lemma cycle_free_loop_dest: "i  n  set xs  {0..n}  cycle_free m n  len m i i xs  𝟭"
unfolding cycle_free_def by auto

lemma cycle_free_dest:
  "cycle_free m n  i  n  j  n  set xs  {0..n}
     len m i j (rem_cycles i j xs)  len m i j xs"
by (auto simp add: cycle_free_def)

definition cycle_free_up_to :: "'a mat  nat  nat  bool" where
  "cycle_free_up_to m k n   i xs. i  n  set xs  {0..k} 
  ( j. j  n  len m i j (rem_cycles i j xs)  len m i j xs)  len m i i xs  𝟭"

lemma cycle_free_up_to_loop_dest:
  "i  n  set xs  {0..k}  cycle_free_up_to m k n  len m i i xs  𝟭"
unfolding cycle_free_up_to_def by auto

lemma cycle_free_up_to_diag:
  assumes "cycle_free_up_to m k n" "i  n"
  shows "m i i  𝟭"
using cycle_free_up_to_loop_dest[OF assms(2) _ assms(1), of "[]"] by auto

lemma D_eqI2:
  fixes m n i j k
  defines "A  {len m i j xs | xs. set xs  {0..k}}"
  defines "A_distinct  {len m i j xs | xs. set xs  {0..k}  i  set xs  j  set xs  distinct xs}"
  assumes "cycle_free_up_to m k n" "i  n" "j  n" "k  n"
          "(y. y  A_distinct  x  y)" "x  A"
  shows "D m i j k = x" using assms
proof -
  show ?thesis
  proof (simp add: D_def A_distinct_def[symmetric], rule Min_eqI)
    show "finite A_distinct" using D_base_finite''[of m i j k] unfolding A_distinct_def by auto
  next
    fix y assume "y  A_distinct"
    thus "x  y" using assms by meson
  next
    from assms obtain xs where xs: "x = len m i j xs" "set xs  {0..k}" by auto
    let ?ys = "rem_cycles i j xs"
    let ?y = "len m i j ?ys"
    from assms(3-6) xs have *:"?y  x" by (fastforce simp add: cycle_free_up_to_def)
    have distinct: "i  set ?ys" "j  set ?ys" "distinct ?ys"
    using rem_cycles_distinct remove_all_removes rem_cycles_removes_last by fast+
    with xs(2) have "?y  A_distinct" unfolding A_distinct_def using rem_cycles_subs by fastforce 
    hence "x  ?y" using assms by meson
    moreover have "?y  x" using assms(3-6) xs by (fastforce simp add: cycle_free_up_to_def)
    ultimately have "x = ?y" by simp
    then show "x  A_distinct" using distinct xs(2) rem_cycles_subs[of i j xs]
    unfolding A_distinct_def by fastforce
  qed
qed


section ‹Result Under The Absence of Negative Cycles›

text ‹
  This proves that the algorithm correctly computes shortest paths under the absence of negative
  cycles by a standard argument.
›

theorem fw_shortest_path_up_to:
  "cycle_free_up_to m k n  i'  i  j'  j  i  n  j  n  k  n
         D m i' j' k = fw m n k i j i' j'"
proof (induction k arbitrary: i j i' j')
  case 0
  from cycle_free_up_to_diag[OF 0(1)] have diag: " k  n. m k k  𝟭" by auto
  then have m_diag: "m 0 0  𝟭" by simp
  let ?S = "{len m i' j' xs |xs. set xs  {0}  i'  set xs  j'  set xs  distinct xs}"
  show ?case unfolding D_def
  proof (simp, rule Min_eqI)
    have "?S  {len m i' j' xs |xs. set xs  {0..0}  distinct xs}" by auto
    thus "finite ?S" using D_base_finite[of m i' j' 0] by (rule finite_subset)
  next
    fix l assume "l  ?S"
    then obtain xs where l: "l = len m i' j' xs" and xs: "xs = []  xs = [0]"
    using distinct_list_single_elem_decomp by auto
    { assume "xs = []"
      have "fw m n 0 i j i' j'  fw m n 0 0 0 i' j'" using fw_invariant 0 by blast
      also have "  m i' j'" by (cases "i' = 0  j' = 0") (simp add: fw_upd_def upd_def)+
      finally have "fw m n 0 i j i' j'  l" using xs = [] l by simp
    }
    moreover
    { assume "xs = [0]"
      have "fw m n 0 i j i' j'  fw m n 0 i' j' i' j'" using fw_invariant 0 by blast
      also have "  m i' 0 + m 0 j'"
      proof (cases j')
        assume "j' = 0"
        show ?thesis
        proof (cases i')
          assume "i' = 0"
          thus ?thesis using j' = 0 by (simp add: fw_upd_def upd_def)
        next
          fix i'' assume i'': "i' = Suc i''"
          have "fw_upd (fw m n 0 i'' n) 0 (Suc i'') 0 (Suc i'') 0  fw m n 0 i'' n (Suc i'') 0"
          by (simp add: fw_upd_mono)
          also have "  m (Suc i'') 0" using fw_mono 0 i'' by simp
          finally show ?thesis using j' = 0 m_diag i'' neutr add_mono by fastforce
        qed
      next
        fix j'' assume j'': "j' = Suc j''"
        have "fw_upd (fw m n 0 i' j'') 0 i' (Suc j'') i' (Suc j'')
               fw m n 0 i' j'' i' 0 + fw m n 0 i' j'' 0 (Suc j'') "
        by (simp add: fw_upd_def upd_def)
        also have "  m i' 0 + m 0 (Suc j'')"
        using fw_mono[of i' n j'' i' 0 m 0] fw_mono[of i' n j'' 0 "Suc j''" m 0 ] j'' 0
        by (simp add: add_mono)
        finally show ?thesis using j'' by simp
      qed
      finally have "fw m n 0 i j i' j'  l" using xs = [0] l by simp
    }
    ultimately show "fw m n 0 i j i' j'  l" using xs by auto
  next
    have A: "fw m n 0 i j i' j' = fw m n 0 i' j' i' j'" using single_iteration_inv 0 by blast
    have "fw m n 0 i' j' i' j' = min (m i' j') (m i' 0 + m 0 j')"
    using 0 by (simp add: fw_step_0[of m, OF m_diag])
    hence
      "fw m n 0 i' j' i' j' = m i' j'
       (fw m n 0 i' j' i' j' = m i' 0 + m 0 j' m i' 0 + m 0 j'  m i' j')"
    by (auto simp add: ord.min_def) 
    thus "fw m n 0 i j i' j'  ?S"
    proof (standard, goal_cases)
      case 1
      hence "fw m n 0 i j i' j' = len m i' j' []" using A by auto
      thus ?case by fastforce
    next
      case 2
      hence *:"fw m n 0 i j i' j' = len m i' j' [0]" using A by auto
      thus ?case
      proof (cases "i' = 0  j' = 0")
        case False thus ?thesis using * by fastforce
      next
        case True
        { assume "i' = 0"
          from diag have "m 0 0 + m 0 j'  m 0 j'" by (auto intro: add_mono_neutl)
          with i' = 0 have "fw m n 0 i j i' j' = len m 0 j' []" using 0 A 2 by auto
        } moreover
        { assume "j' = 0"
          from diag have "m i' 0 + m 0 0  m i' 0" by (auto intro: add_mono_neutr)
          with j' = 0 have "fw m n 0 i j i' j' = len m i' 0 []" using 0 A 2 by auto
        }
        ultimately have "fw m n 0 i j i' j' = len m i' j' []" using True by auto
        then show ?thesis by fastforce
      qed
    qed
  qed
next
  case (Suc k)
  from cycle_free_up_to_diag[OF Suc.prems(1)] have diag: " k  n. m k k  𝟭" by auto
  from Suc.prems have cycle_free_to_k:
    "cycle_free_up_to m k n" by (fastforce simp add: cycle_free_up_to_def)
  { fix k' assume "k'  n"
    with Suc cycle_free_to_k have "D m k' k' k = fw m n k n n k' k'" by auto
    from D_dest''[OF this[symmetric]] obtain xs where
      "set xs  {0..k}" "fw m n k n n k' k'= len m k' k' xs"
    by auto
    with Suc(2) ‹Suc k  n k'  n have "fw m n k n n k' k'  𝟭"
    unfolding cycle_free_up_to_def by force
  }
  hence K: "k'n. fw m n k n n k' k'  𝟭" by simp
  let ?S = "λ k i j. {len m i j xs |xs. set xs  {0..k}  i  set xs  j  set xs  distinct xs}"
  show ?case
  proof (rule D_eqI2)
    show "cycle_free_up_to m (Suc k) n" using Suc.prems(1) .
  next
    show "i'  n" using Suc.prems by simp
  next
    show "j'  n" using Suc.prems by simp
  next
    show "Suc k  n" using Suc.prems by simp
  next
    fix l assume "l  {len m i' j' xs | xs. set xs  {0..Suc k}  i'  set xs  j'  set xs  distinct xs}"
    then obtain xs where xs:
      "l = len m i' j' xs" "set xs  {0..Suc k}" "i'  set xs" "j'  set xs" "distinct xs"
    by auto
    have IH: "D m i' j' k = fw m n k i j i' j'" using cycle_free_to_k Suc by auto
    have fin:
      "finite {len m i' j' xs |xs. set xs  {0..k}  i'  set xs  j'  set xs  distinct xs}"
    using D_base_finite'' by simp
    show "fw m n (Suc k) i j i' j'  l"
    proof (cases "Suc k  set xs")
      case False
      hence "set xs  {0..k}" using xs(2) using atLeastAtMostSuc_conv by auto
      hence
        "l  {len m i' j' xs | xs. set xs  {0..k}  i'  set xs  j'  set xs  distinct xs}"
      using xs by auto
      with Min_le[OF fin this] have "fw m n k i j i' j'  l" using IH by (simp add: D_def)
      thus ?thesis using fw_invariant[of k "Suc k" i n j j i m i' j'] Suc.prems by simp
    next
      case True
      then obtain ys zs where ys_zs_id: "xs = ys @ Suc k # zs" by (meson split_list)
      with xs(5) have ys_zs: "distinct ys" "distinct zs" "Suc k  set ys" "Suc k  set zs"
      "set ys  set zs = {}" by auto
      have "i'  Suc k" "j'  Suc k" using xs(3,4) True by auto

      have "set ys  {0..k}" using ys_zs(3) xs(2) ys_zs_id using atLeastAtMostSuc_conv by auto
      hence "len m i' (Suc k) ys  ?S k i' (Suc k)" using ys_zs_id ys_zs xs(3) by fastforce
      with Min_le[OF _ this] have "Min (?S k i' (Suc k))  len m i' (Suc k) ys"
      using D_base_finite'[of m i' "Suc k" k] i'  Suc k by fastforce
      moreover have "fw m n k n n i' (Suc k)  =  D m i' (Suc k) k"
      using Suc.IH[OF cycle_free_to_k, of i' n] Suc.prems by auto
      ultimately have *:"fw m n k n n i' (Suc k)  len m i' (Suc k) ys" using i'  Suc k
      by (auto simp: D_def)

      have "set zs  {0..k}" using ys_zs(4) xs(2) ys_zs_id using atLeastAtMostSuc_conv by auto
      hence "len m (Suc k) j' zs  ?S k (Suc k) j'" using ys_zs_id ys_zs xs(3,4,5) by fastforce
      with Min_le[OF _ this] have "Min (?S k (Suc k) j')  len m (Suc k) j' zs"
      using D_base_finite'[of m "Suc k" j' k] j'  Suc k by fastforce
      moreover have "fw m n k n n (Suc k) j'  =  D m (Suc k) j' k"
      using Suc.IH[OF cycle_free_to_k, of "Suc k" n j' n] Suc.prems by auto
      ultimately have **:"fw m n k n n (Suc k) j'  len m (Suc k) j' zs" using j'  Suc k
      by (auto simp: D_def)

      have len_eq: "l = len m i' (Suc k) ys + len m (Suc k) j' zs"
      by (simp add: xs(1) len_decomp[OF ys_zs_id, symmetric] ys_zs_id)
      have "fw m n (Suc k) i' j' i' j'  fw m n k n n i' (Suc k) + fw m n k n n (Suc k) j'"
      using fw_step_Suc[of n m k i' j', OF K] Suc.prems(2-) by simp
      hence "fw m n (Suc k) i' j' i' j'  l"
      using fw_step_Suc[of n m k i j] Suc.prems(3-) * ** len_eq add_mono by fastforce
      thus ?thesis using fw_invariant[of "Suc k" "Suc k" i n j j' i' m i' j'] Suc.prems(2-) by simp
    qed
  next
    have "fw m n (Suc k) i j i' j' = fw m n (Suc k) i' j' i' j'"
    using single_iteration_inv[OF Suc.prems(2-5)] .
    also have " = min (fw m n k n n i' j') (fw m n k n n i' (Suc k) + fw m n k n n (Suc k) j')"
    using fw_step_Suc[OF K] Suc.prems(2-) by simp
    finally show "fw m n (Suc k) i j i' j'  {len m i' j' xs | xs. set xs  {0..Suc k}}"
    proof (cases "fw m n (Suc k) i j i' j' = fw m n k n n i' j'", goal_cases)
      case True
      have "fw m n (Suc k) i j i' j' = D m i' j' k"
      using Suc.IH[OF cycle_free_to_k, of i' n j' n] Suc.prems(2-) True by simp
      from D_dest'[OF this] show ?thesis by blast
    next
      case 2
      hence A:"fw m n (Suc k) i j i' j' = fw m n k n n i' (Suc k) + fw m n k n n (Suc k) j'"
      by (metis ord.min_def)
      have "fw m n k n n i' j' = D m i' j' k"
      using Suc.IH[OF cycle_free_to_k, of i' n j' n] Suc.prems by simp
      from D_dest[OF this] have B:"fw m n k n n i' j'  ?S (Suc k) i' j'"
      by blast
      have "fw m n k n n i' (Suc k) = D m i' (Suc k) k"
      using Suc.IH[OF cycle_free_to_k, of i' n "Suc k" n] Suc.prems by simp
      from D_dest'[OF this] obtain xs where xs:
        "fw m n k n n i' (Suc k) = len m i' (Suc k) xs" "set xs  {0..Suc k}" by blast
      have "fw m n k n n (Suc k) j' = D m (Suc k) j' k"
      using Suc.IH[OF cycle_free_to_k, of "Suc k" n j' n] Suc.prems by simp
      from D_dest'[OF this] obtain ys where ys:
        "fw m n k n n (Suc k) j' = len m (Suc k) j' ys" "set ys  {0..Suc k}" by blast
      from A xs(1) ys(1) len_comp
      have "fw m n (Suc k) i j i' j' = len m i' j' (xs @ Suc k # ys)" by simp
      moreover have "set (xs @ Suc k # ys)  {0..Suc k}" using xs(2) ys(2) by auto
      ultimately show ?thesis by blast
    qed
  qed
qed

lemma cycle_free_cycle_free_up_to:
  "cycle_free m n  k  n  cycle_free_up_to m k n"
unfolding cycle_free_def cycle_free_up_to_def by force

lemma cycle_free_diag:
  "cycle_free m n  i  n  𝟭  m i i"
using cycle_free_up_to_diag[OF cycle_free_cycle_free_up_to] by blast

corollary fw_shortest_path:
  "cycle_free m n  i'  i  j'  j  i  n  j  n  k  n
         D m i' j' k = fw m n k i j i' j'"
using fw_shortest_path_up_to[OF cycle_free_cycle_free_up_to] by auto

corollary fw_shortest:
  assumes "cycle_free m n" "i  n" "j  n" "k  n"
  shows "fw m n n n n i j  fw m n n n n i k + fw m n n n n k j"
proof (rule ccontr, goal_cases)
  case 1
  let ?S = "λ i j. {len m i j xs |xs. set xs  {0..n}}"
  let ?FW = "fw m n n n n"
  from assms fw_shortest_path
  have FW: "?FW i j = D m i j n" "?FW i k = D m i k n" "?FW k j = D m k j n" by auto
  with D_dest'' FW have "?FW i k  ?S i k" "?FW k j  ?S k j" by auto
  then obtain xs ys where xs_ys:
    "?FW i k = len m i k xs" "set xs  {0..n}" "?FW k j = len m k j ys" "set ys  {0..n}" by auto
  let ?zs = "rem_cycles i j (xs @ k # ys)"
  have *:"?FW i j = Min {len m i j xs |xs. set xs  {0..n}  i  set xs  j  set xs  distinct xs}"
  using FW(1) unfolding D_def .
  have "set (xs @ k # ys)  {0..n}" using assms xs_ys by fastforce
  from cycle_free_dest [OF ‹cycle_free m n i  n j  n this]
  have **:"len m i j ?zs  len m i j (xs @ k # ys)" by auto
  moreover have "i  set ?zs" "j  set ?zs" "distinct ?zs"
  using rem_cycles_distinct remove_all_removes rem_cycles_removes_last by fast+
  moreover have "set ?zs  {0..n}" using rem_cycles_subs[of i j"xs @ k # ys"] xs_ys assms by fastforce
  ultimately have
    "len m i j ?zs  {len m i j xs |xs. set xs  {0..n}  i  set xs  j  set xs  distinct xs}"
  by blast
  with * have "?FW i j  len m i j ?zs" using D_base_finite'' by auto
  with ** xs_ys len_comp 1 show ?case by auto
qed


section ‹Result Under the Presence of Negative Cycles›

lemma not_cylce_free_dest: "¬ cycle_free m n   k  n. ¬ cycle_free_up_to m k n"
by (auto simp add: cycle_free_def cycle_free_up_to_def)

lemma D_not_diag_le:
  "(x :: 'a)  {len m i j xs |xs. set xs  {0..k}  i  set xs  j  set xs  distinct xs}
   D m i j k  x" using Min_le[OF D_base_finite''] by (auto simp add: D_def)

lemma D_not_diag_le': "set xs  {0..k}  i  set xs  j  set xs  distinct xs
   D m i j k  len m i j xs" using Min_le[OF D_base_finite''] by (fastforce simp add: D_def)

lemma (in -) nat_upto_subs_top_removal':
  "S  {0..Suc n}  Suc n  S  S  {0..n}"
apply (induction n)
 apply safe
 apply (rename_tac x)
 apply (case_tac "x = Suc 0"; fastforce)
apply (rename_tac n x)
apply (case_tac "x = Suc (Suc n)"; fastforce)
done

lemma (in -) nat_upto_subs_top_removal:
  "S  {0..n::nat}  n  S  S  {0..n - 1}"
using nat_upto_subs_top_removal' by (cases n; simp)

lemma fw_Suc:
  "i  n  j  n  i'  n  j'  n  fw m n (Suc k) i' j' i j  fw m n k n n i j"
by (metis Suc_innermost_id1' Suc_innermost_id2 Suc_innermost_mono linorder_class.not_le order.eq_iff
          preorder_class.order_refl single_iteration_inv single_iteration_inv')

lemma negative_len_shortest:
  "length xs = n  len m i i xs < 𝟭
      j ys. distinct (j # ys)  len m j j ys < 𝟭  j  set (i # xs)  set ys  set xs"
proof (induction n arbitrary: xs i rule: less_induct)
  case (less n)
  show ?case
  proof (cases xs)
    case Nil
    thus ?thesis using less.prems by auto
  next
    case (Cons y ys)
    then have "length xs  1" by auto
    show ?thesis
    proof (cases "i  set xs")
      assume i: "i  set xs"
      then obtain as bs where xs: "xs = as @ i # bs" by (meson split_list)
      show ?thesis
      proof (cases "len m i i as < 𝟭")
        case True
        from xs less.prems have "length as < n" by auto
        from less.IH[OF this _ True] xs show ?thesis by auto
      next
        case False
        from len_decomp[OF xs] have "len m i i xs = len m i i as + len m i i bs" by auto
        with False less.prems have *: "len m i i bs < 𝟭"
        by (metis add_lt_neutral local.dual_order.strict_trans local.neqE)
        from xs less.prems have "length bs < n" by auto
        from less.IH[OF this _ *] xs show ?thesis by auto
      qed
    next
      assume i: "i  set xs"
      show ?thesis
      proof (cases "distinct xs")
        case True
        with i less.prems show ?thesis by auto
      next
        case False
        from not_distinct_decomp[OF this] obtain a as bs cs where xs:
          "xs = as @ a # bs @ a # cs"
        by auto
        show ?thesis
        proof (cases "len m a a bs < 𝟭")
          case True
          from xs less.prems have "length bs < n" by auto
          from less.IH[OF this _ True] xs show ?thesis by auto
        next
          case False
          from len_decomp[OF xs, of m  i i] len_decomp[of "bs @ a # cs" bs a cs m a i]
          have *:"len m i i xs = len m i a as + (len m a a bs + len m a i cs)" by auto
          from False have "len m a a bs  𝟭" by auto
          with add_mono have "len m a a bs + len m a i cs  len m a i cs" by fastforce
          with * have "len m i i xs  len m i a as + len m a i cs" by (simp add: add_mono)
          with less.prems(2) have "len m i a as + len m a i cs < 𝟭" by auto
          with len_comp have "len m i i (as @ a # cs) < 𝟭" by auto
          from less.IH[OF _ _ this, of "length (as @ a # cs)"] xs less.prems
          show ?thesis by auto
        qed
      qed
    qed
  qed
qed

theorem FW_neg_cycle_detect:
  "¬ cycle_free m n   i  n. fw m n n n n i i < 𝟭"
proof -
  assume A: "¬ cycle_free m n"
  let ?K = "{k. k  n  ¬ cycle_free_up_to m k n}"
  let ?k = "Min ?K"
  have not_empty_K: "?K  {}" using not_cylce_free_dest[OF A(1)] by auto
  have "finite ?K" by auto
  with not_empty_K have *:
    " k' < ?k. cycle_free_up_to m k' n"
  by (auto, metis le_trans less_or_eq_imp_le preorder_class.less_irrefl)
  from linorder_class.Min_in[OF ‹finite ?K ?K  {}] have
    "¬ cycle_free_up_to m ?k n" "?k  n"
  by auto
  then have " xs j. j  n  len m j j xs < 𝟭  set xs  {0..?k}" unfolding cycle_free_up_to_def
  proof (auto, goal_cases)
    case (2 i xs) then have "len m i i xs < 𝟭" by auto
    with 2 show ?case by auto
  next
    case (1 i xs j)
    then have "len m i j (rem_cycles i j xs) > len m i j xs" by auto
    from negative_cycle_dest[OF this]
    obtain i' ys where ys: "i'  set (i # j # xs)" "len m i' i' ys < 𝟭" "set ys  set xs" by blast
    from ys(1) 1(2-4) show ?case
    proof (auto, goal_cases)
      case 1
      with ys(2,3) show ?case by auto
    next
      case 2
      with ys(2,3) show ?case by auto
    next
      case 3
      with ?k  n have "i'  n" unfolding cycle_free_up_to_def by auto
      with 3 ys(2,3) show ?case by auto
    qed
  qed
  then obtain a as where a_as: "a  n  len m a a as < 𝟭  set as  {0..?k}" by auto
  with negative_len_shortest[of as "length as" m a] obtain j xs where j_xs:
  "distinct (j # xs)  len m j j xs < 𝟭  j  set (a # as)  set xs  set as" by auto
  with a_as ?k  n have cyc: "j  n" "set xs  {0..?k}" "len m j j xs < 𝟭" "distinct (j # xs)"
  by auto
  { assume "?k > 0"
    then have "?k - 1 < ?k" by simp
    with * have **:"cycle_free_up_to m (?k - 1) n" by blast
    have "?k  set xs"
    proof (rule ccontr, goal_cases)
      case 1
      with ‹set xs  {0..?k} nat_upto_subs_top_removal have "set xs  {0..?k-1}" by auto
      from cycle_free_up_to_loop_dest[OF j  n this ‹cycle_free_up_to m (?k - 1) n] cyc(3)
      show ?case by auto
    qed
    with cyc(4) have "j  ?k" by auto
    from ?k  set xs obtain ys zs where "xs = ys @ ?k # zs" by (meson split_list)
    with ‹distinct (j # xs)
    have xs: "xs = ys @ ?k # zs" "distinct ys" "distinct zs" "?k  set ys" "?k  set zs"
             "j  set ys" "j  set zs" by auto
    from xs(1,4) ‹set xs  {0..?k} nat_upto_subs_top_removal have ys: "set ys  {0..?k-1}" by auto
    from xs(1,5) ‹set xs  {0..?k} nat_upto_subs_top_removal have zs: "set zs  {0..?k-1}" by auto
    have "D m j ?k (?k - 1) = fw m n (?k - 1) n n j ?k"
    using ?k  n j  n fw_shortest_path_up_to[OF **, of j n ?k n] by auto
    moreover have "D m ?k j (?k - 1) = fw m n (?k - 1) n n ?k j"
    using ?k  n j  n fw_shortest_path_up_to[OF **, of ?k n j n] by auto
    ultimately have "fw m n (?k - 1) n n j ?k + fw m n (?k - 1) n n ?k j  len m j ?k ys + len m ?k j zs"
    using D_not_diag_le'[OF zs(1) xs(5,7,3), of m]
          D_not_diag_le'[OF ys(1) xs(6,4,2), of m] by (auto simp: add_mono)
    then have neg: "fw m n (?k - 1) n n j ?k + fw m n (?k - 1) n n ?k j < 𝟭"
    using xs(1) ‹len m j j xs < 𝟭 len_comp by auto
    have "fw m n ?k j j j j  fw m n (?k - 1) n n j ?k + fw m n (?k - 1) n n ?k j"
    proof (cases "j = 0")
      case True
      with?k > 0 fw.simps(2)[of m n "?k - 1"]
      have "fw m n ?k j j = fw_upd (fw m n (?k - 1) n n) ?k j j" by auto
      then have "fw m n ?k j j j j  fw m n (?k - 1) n n j ?k + fw m n (?k - 1) n n ?k j"
      by (simp add: fw_upd_def upd_def)
      then show ?thesis by auto
    next
      case False
      with fw.simps(4)[of m n ?k j "j - 1"]
      have "fw m n ?k j j = fw_upd (fw m n ?k j (j -1)) ?k j j" by simp
      then have *: "fw m n ?k j j j j  fw m n ?k j (j -1) j ?k + fw m n ?k j (j -1) ?k j"
      by (simp add: fw_upd_def upd_def)
      have "j - 1 < n" using j  n False by auto
      then have "fw m n ?k j (j -1) j ?k  fw m n (?k - 1) n n j ?k"
      using fw_Suc[of j n ?k j "j - 1" m "?k - 1"] j  n ?k  n ?k > 0 by auto
      moreover have "fw m n ?k j (j -1) ?k j  fw m n (?k - 1) n n ?k j"
      using fw_Suc[of ?k n j j "j - 1" m "?k - 1"] j  n ?k  n ?k > 0 by auto
      ultimately have "fw m n ?k j j j j  fw m n (?k - 1) n n j ?k + fw m n (?k - 1) n n ?k j"
      using * add_mono by fastforce
      then show ?thesis by auto
    qed
    with neg have "fw m n ?k j j j j < 𝟭" by auto
    moreover have "fw m n n n n j j  fw m n ?k j j j j" using fw_invariant jn ?k  n by auto
    ultimately have "fw m n n n n j j < 𝟭" using neg by auto
    with jn have ?thesis by auto
  }
  moreover
  { assume "?k = 0"
    with cyc(2,4) have "xs = []  xs = [0]"
      apply safe
      apply (case_tac xs)
       apply fastforce
      apply (rename_tac ys)
      apply (case_tac ys)
       apply auto
    done
    then have ?thesis
    proof
      assume "xs = []"
      with cyc have "m j j < 𝟭" by auto
      with fw_mono[of n n n j j m n] j  n have "fw m n n n n j j < 𝟭" by auto
      with j  n show ?thesis by auto
    next
      assume xs: "xs = [0]"
      with cyc have "m j 0 + m 0 j < 𝟭" by auto
      then have "fw m n 0 j j j j < 𝟭"
      proof (cases "j = 0", goal_cases)
        case 1
        have "m j j < 𝟭"
        proof (rule ccontr)
          assume "¬ m j j < 𝟭"
          with 1 have "m 0 0  𝟭" by simp
          with add_mono have "m 0 0 + m 0 0  𝟭" by fastforce
          with 1 show False by simp
        qed
        with fw_mono[of j n j j j m 0] j  n show ?thesis by auto
      next
        case 2
        with fw.simps(4)[of m n 0 j "j - 1"]
        have "fw m n 0 j j = fw_upd (fw m n 0 j (j - 1)) 0 j j" by simp
        then have "fw m n 0 j j j j  fw m n 0 j (j - 1) j 0 + fw m n 0 j (j - 1) 0 j"
        by (simp add: fw_upd_def upd_def)
        also have "  m j 0 + m 0 j" using j  n add_mono fw_mono by auto
        finally show ?thesis using 2 by auto
      qed
      then have "fw m n 0 n n j j < 𝟭" by (metis cyc(1) less_or_eq_imp_le single_iteration_inv) 
      with fw_invariant[of 0 n n n n n n m j j] j  n have "fw m n n n n j j < 𝟭" by auto
      with j  n show ?thesis by blast
    qed
  }
  ultimately show ?thesis by auto
qed

end (* End of local class context *)
end (* End of theory *)

Theory Timed_Automata

theory Timed_Automata
  imports Main
begin

chapter ‹Basic Definitions and Semantics›

section ‹Time›

class time = linordered_ab_group_add +
  assumes dense: "x < y  z. x < z  z < y"
  assumes non_trivial: " x. x  0"

begin

lemma non_trivial_neg: " x. x < 0"
proof -
  from non_trivial obtain x where "x  0" by auto
  then show ?thesis
  proof (cases "x < 0", auto, goal_cases)
    case 1
    then have "x > 0" by auto
    then have "(-x) < 0" by auto
    then show ?case by blast
  qed
qed

end

datatype ('c, 't :: time) cconstraint =
  AND "('c, 't) cconstraint" "('c, 't) cconstraint" |
  LT 'c 't |
  LE 'c 't |
  EQ 'c 't |
  GT 'c 't |
  GE 'c 't

section ‹Syntactic Definition›

text ‹
  For an informal description of timed automata we refer to Bengtsson and Yi \cite{BengtssonY03}.
  We define a timed automaton A›

type_synonym
  ('c, 'time, 's) invassn = "'s  ('c, 'time) cconstraint"

type_synonym
  ('a, 'c, 'time, 's) transition = "'s * ('c, 'time) cconstraint * 'a * 'c list * 's"

type_synonym
  ('a, 'c, 'time, 's) ta = "('a, 'c, 'time, 's) transition set * ('c, 'time, 's) invassn"

definition trans_of :: "('a, 'c, 'time, 's) ta  ('a, 'c, 'time, 's) transition set" where
  "trans_of  fst"
definition inv_of  :: "('a, 'c, 'time, 's) ta  ('c, 'time, 's) invassn" where
  "inv_of  snd"

abbreviation transition ::
  "('a, 'c, 'time, 's) ta  's  ('c, 'time) cconstraint  'a  'c list  's  bool"
("_  _ ⟶⇗_,_,_ _" [61,61,61,61,61,61] 61) where
  "(A  lg,a,r l')  (l,g,a,r,l')  trans_of A"

subsection ‹Collecting Information About Clocks›

fun collect_clks :: "('c, 't :: time) cconstraint  'c set"
where
  "collect_clks (AND cc1 cc2) = collect_clks cc1  collect_clks cc2" |
  "collect_clks (LT c _) = {c}" |
  "collect_clks (LE c _) = {c}" |
  "collect_clks (EQ c _) = {c}" |
  "collect_clks (GE c _) = {c}" |
  "collect_clks (GT c _) = {c}"

fun collect_clock_pairs :: "('c, 't :: time) cconstraint  ('c * 't) set"
where
  "collect_clock_pairs (LT x m) = {(x, m)}" |
  "collect_clock_pairs (LE x m) = {(x, m)}" |
  "collect_clock_pairs (EQ x m) = {(x, m)}" |
  "collect_clock_pairs (GE x m) = {(x, m)}" |
  "collect_clock_pairs (GT x m) = {(x, m)}" |
  "collect_clock_pairs (AND cc1 cc2) = (collect_clock_pairs cc1  collect_clock_pairs cc2)"

definition collect_clkt :: "('a, 'c, 't::time, 's) transition set  ('c *'t) set"
where
  "collect_clkt S =  {collect_clock_pairs (fst (snd t)) | t . t  S}"

definition collect_clki :: "('c, 't :: time, 's) invassn  ('c *'t) set"
where
  "collect_clki I =  {collect_clock_pairs (I x) | x. True}"

definition clkp_set :: "('a, 'c, 't :: time, 's) ta  ('c *'t) set"
where
  "clkp_set A = collect_clki (inv_of A)  collect_clkt (trans_of A)"

definition collect_clkvt :: "('a, 'c, 't::time, 's) transition set  'c set"
where
  "collect_clkvt S =  {set ((fst o snd o snd o snd) t) | t . t  S}"

abbreviation clk_set where "clk_set A  fst ` clkp_set A  collect_clkvt (trans_of A)"

(* We don not need this here but most other theories will make use of this predicate *)
inductive valid_abstraction
where
  "(x,m)  clkp_set A. m  k x  x  X  m  ; collect_clkvt (trans_of A)  X; finite X
   valid_abstraction A X k"

section ‹Operational Semantics›

type_synonym ('c, 't) cval = "'c  't"

definition cval_add :: "('c,'t) cval  't::time  ('c,'t) cval" (infixr "" 64)
where
  "u  d = (λ x. u x + d)"

inductive clock_val :: "('c, 't) cval  ('c, 't::time) cconstraint  bool" ("_  _" [62, 62] 62)
where
  "u  cc1; u  cc2  u  AND cc1 cc2" |
  "u c < d  u  LT c d" |
  "u c  d  u  LE c d" |
  "u c = d  u  EQ c d" |
  "u c  d  u  GE c d" |
  "u c > d  u  GT c d"

declare clock_val.intros[intro]

inductive_cases[elim!]: "u  AND cc1 cc2"
inductive_cases[elim!]: "u  LT c d"
inductive_cases[elim!]: "u  LE c d"
inductive_cases[elim!]: "u  EQ c d"
inductive_cases[elim!]: "u  GE c d"
inductive_cases[elim!]: "u  GT c d"

fun clock_set :: "'c list  't::time  ('c,'t) cval  ('c,'t) cval"
where
  "clock_set [] _ u = u" |
  "clock_set (c#cs) t u = (clock_set cs t u)(c:=t)"

abbreviation clock_set_abbrv :: "'c list  't::time  ('c,'t) cval  ('c,'t) cval"
("[__]_" [65,65,65] 65)
where
  "[r  t]u  clock_set r t u"

inductive step_t ::
  "('a, 'c, 't, 's) ta  's  ('c, 't) cval  ('t::time)  's  ('c, 't) cval  bool"
("_  _, _ →⇗_ _, _" [61,61,61] 61)                      
where
  "u  inv_of A l; u  d  inv_of A l; d  0  A  l, ud l, u  d"

declare step_t.intros[intro!]

inductive_cases[elim!]: "A  l, ud l',u'"

lemma step_t_determinacy1:
  "A  l, ud l',u'   A  l, ud l'',u''  l' = l''"
by auto

lemma step_t_determinacy2:
  "A  l, ud l',u'   A  l, ud l'',u''  u' = u''"
by auto

lemma step_t_cont1:
  "d  0  e  0  A  l, ud l',u'  A  l', u'e l'',u''
   A  l, ud+e l'',u''"
proof -
  assume A: "d  0" "e  0" "A  l, ud l',u'" "A  l', u'e l'',u''"
  hence "u' = (u  d)" "u'' = (u'  e)" by auto
  hence "u'' = (u  (d + e))" unfolding cval_add_def by auto
  with A show ?thesis by auto
qed

inductive step_a ::
  "('a, 'c, 't, 's) ta  's  ('c, ('t::time)) cval  'a  's  ('c, 't) cval  bool"
("_  _, _ →⇘_ _, _" [61,61,61] 61)
where
  "A  lg,a,r l'; u  g; u'  inv_of A l'; u' = [r  0]u  (A  l, ua l', u')"

inductive step ::
  "('a, 'c, 't, 's) ta  's  ('c, ('t::time)) cval  's  ('c, 't) cval  bool"
("_  _, _  _,_" [61,61,61] 61)
where
  step_a: "A  l, ua l',u'  (A  l, u  l',u')" |
  step_t: "A  l, ud l',u'  (A  l, u  l',u')"

inductive_cases[elim!]: "A  l, u  l',u'"

declare step.intros[intro]

inductive
  steps :: "('a, 'c, 't, 's) ta  's  ('c, ('t::time)) cval  's  ('c, 't) cval  bool"
("_  _, _ →* _, _" [61,61,61] 61)
where
  refl: "A  l, u →* l, u" |
  step: "A  l, u  l', u'  A  l', u' →* l'', u''  A  l, u →* l'', u''"

declare steps.intros[intro]

section ‹Zone Semantics›

type_synonym ('c, 't) zone = "('c, 't) cval set"

definition zone_delay :: "('c, ('t::time)) zone  ('c, 't) zone"
("_" [71] 71)
where
  "Z = {u  d|u d. u  Z  d  (0::'t)}"

definition zone_set :: "('c, 't::time) zone  'c list  ('c, 't) zone"
("__  0⇙" [71] 71)
where
  "zone_set Z r = {[r  (0::'t)]u | u . u  Z}"

inductive step_z ::
  "('a, 'c, 't, 's) ta  's  ('c, ('t::time)) zone  's  ('c, 't) zone  bool"
("_  _, _  _, _" [61,61,61] 61)
where
  step_t_z: "A  l, Z  l, (Z  {u. u  inv_of A l})  {u. u  inv_of A l}" |
  step_a_z: "A  lg,a,r l'
               (A  l, Z  l', zone_set (Z  {u. u  g}) r  {u. u  inv_of A l'} )"

inductive_cases[elim!]: "A  l, u  l', u'"

declare step_z.intros[intro]

lemma step_z_sound:
  "A  l, Z  l',Z'  ( u'  Z'.  u  Z.  A  l, u  l',u')"
proof (induction rule: step_z.induct, goal_cases)
  case 1 thus ?case unfolding zone_delay_def by blast
next
  case (2 A l g a r l' Z)
  show ?case
  proof
    fix u' assume "u'  zone_set (Z  {u. u  g}) r  {u. u  inv_of A l'}"
    then obtain u where
      "u  g" "u'  inv_of A l'" "u' = [r0]u" "u  Z"
    unfolding zone_set_def by auto
    with step_a.intros[OF 2 this(1-3)] show "uZ. A  l, u  l',u'" by fast
  qed
qed

lemma step_z_complete:
  "A  l, u  l', u'  u  Z   Z'. A  l, Z  l', Z'  u'  Z'"
proof (induction rule: step.induct, goal_cases)
  case (1 A l u a l' u')
  then obtain g r
  where u': "u' = [r0]u" "A  lg,a,r l'" "u  g" "[r0]u  inv_of A l'"
  by (cases rule: step_a.cases) auto
  hence "u'  zone_set (Z  {u. u  g}) r  {u. u  inv_of A l'}"
  unfolding zone_set_def using u  Z by blast
  with u'(1,2) show ?case by blast
next
  case (2 A l u d l' u')
  hence u': "u' = (u  d)" "u  inv_of A l" "u  d  inv_of A l" "0  d" and "l = l'" by auto
  with u' u  Z have
    "u'  {u''  d |u'' d. u''  Z  {u. u  inv_of A l}  0  d}  {u. u  inv_of A l}"
  by fastforce
  thus ?case using l = l'  step_t_z[unfolded zone_delay_def, of A l] by blast
qed

text ‹
  Corresponds to version in old papers --
  not strong enough for inductive proof over transitive closure relation.
›
lemma step_z_complete1:
  "A  l, u  l', u'   Z. A  l, {u}  l', Z  u'  Z"
proof (induction rule: step.induct, goal_cases)
  case (1 A l u a l' u')
  then obtain g r
  where u': "u' = [r0]u" "A  lg,a,r l'" "u  g" "[r0]u  inv_of A l'"
  by (cases rule: step_a.cases) auto
  hence "{[r0]u} = zone_set ({u}  {u. u  g}) r  {u. u  inv_of A l'}"
  unfolding zone_set_def by blast
  with u'(1,2) show ?case by auto 
next
  case (2 A l u d l' u')
  hence u': "u' = (u  d)" "u  inv_of A l" "u  d  inv_of A l" "0  d" and "l = l'" by auto
  hence "{u} = {u}  {u''. u''  inv_of A l}" by fastforce 
  with u'(1) have "{u'} = {u''  d |u''. u''  {u}  {u''. u''  inv_of A l}}" by fastforce
  with u' have
    "u'  {u''  d |u'' d. u''  {u}  {u. u  inv_of A l}  0  d}  {u. u  inv_of A l}"
  by fastforce
  thus ?case using l = l' step_t_z[unfolded zone_delay_def, of A l "{u}"] by blast
qed

text ‹
  Easier proof.
›
lemma step_z_complete2:
  "A  l, u  l', u'   Z. A  l, {u}  l', Z  u'  Z"
using step_z_complete by fast

inductive
  steps_z :: "('a, 'c, 't, 's) ta  's  ('c, ('t::time)) zone  's  ('c, 't) zone  bool"
("_  _, _ ↝* _, _" [61,61,61] 61)
where
  refl: "A  l, Z ↝* l, Z" |
  step: "A  l, Z  l', Z'  A  l', Z' ↝* l'', Z''  A  l, Z ↝* l'', Z''"

declare steps_z.intros[intro]

lemma steps_z_sound:
  "A  l, Z ↝* l', Z'  u'  Z'   u  Z. A  l, u →* l', u'"
proof (induction A l _ l' _ arbitrary: rule: steps_z.induct, goal_cases)
  case refl thus ?case by fast
next
  case (step A l Z l' Z' l'' Z'')
  then obtain u'' where u'': "A  l', u'' →* l'',u'" "u''  Z'" by auto
  then obtain u where "u  Z" "A  l, u  l',u''" using step_z_sound[OF step(1)] by blast
  with u'' show ?case by blast
qed

lemma steps_z_complete:
  "A  l, u →* l', u'  u  Z   Z'. A  l, Z ↝* l', Z'  u'  Z'"
proof (induction arbitrary: Z rule: steps.induct)
  case refl thus ?case by auto
next
  case (step A l u l' u' l'' u'' Z)
  from step_z_complete[OF this(1,4)] obtain Z' where Z': "A  l, Z  l',Z'" "u'  Z'" by auto
  then obtain Z'' where "A  l', Z' ↝* l'',Z''" "u''  Z''" using step by metis
  with Z' show ?case by blast
qed

end

Theory DBM

theory DBM
  imports Floyd_Warshall Timed_Automata
begin

chapter ‹Difference Bound Matrices›

section ‹Definitions›

text ‹
  Difference Bound Matrices (DBMs) constrain differences of clocks
  (or more precisely, the difference of values assigned to individual clocks by a valuation).
  The possible constraints are given by the following datatype:
›

datatype ('t::time) DBMEntry = Le 't | Lt 't | INF ("")

text ‹\noindent This yields a simple definition of DBMs:›

type_synonym 't DBM = "nat  nat  't DBMEntry"

text ‹\noindent
  To relate clocks with rows and columns of
  a DBM, we use a clock numbering v› of type @{typ "'c  nat"} to map clocks to indices.
  DBMs will regularly be  accompanied by a natural number $n$,
  which designates the number of clocks constrained by the matrix.
  To be able to represent the full set of clock constraints with DBMs, we add an imaginary
  clock 𝟬›, which shall be assigned to 0 in every valuation.
  In the following predicate we explicitly keep track of 𝟬›.
›

inductive dbm_entry_val :: "('c, 't) cval  'c option  'c option  ('t::time) DBMEntry  bool"
where
  "u r  d  dbm_entry_val u (Some r) None (Le d)" |
  "-u c  d  dbm_entry_val u None (Some c) (Le d)" |
  "u r < d  dbm_entry_val u (Some r) None (Lt d)" |
  "-u c < d  dbm_entry_val u None (Some c) (Lt d)" |
  "u r - u c  d  dbm_entry_val u (Some r) (Some c) (Le d)" |
  "u r - u c < d  dbm_entry_val u (Some r) (Some c) (Lt d)" |
  "dbm_entry_val _ _ _ "

declare dbm_entry_val.intros[intro]
inductive_cases[elim!]: "dbm_entry_val u None (Some c) (Le d)"
inductive_cases[elim!]: "dbm_entry_val u (Some c) None (Le d)"
inductive_cases[elim!]: "dbm_entry_val u None (Some c) (Lt d)"
inductive_cases[elim!]: "dbm_entry_val u (Some c) None (Lt d)"
inductive_cases[elim!]: "dbm_entry_val u (Some r) (Some c) (Le d)"
inductive_cases[elim!]: "dbm_entry_val u (Some r) (Some c) (Lt d)"

fun dbm_entry_bound :: "('t::time) DBMEntry  't"
where
  "dbm_entry_bound (Le t) = t" |
  "dbm_entry_bound (Lt t) = t" |
  "dbm_entry_bound  = 0"

inductive dbm_lt :: "('t::time) DBMEntry  't DBMEntry  bool"
("_  _" [51, 51] 50)
where
  "dbm_lt (Lt _) " |
  "dbm_lt (Le _) " |
  "a < b   dbm_lt (Le a) (Le b)" |
  "a < b   dbm_lt (Le a) (Lt b)" |
  "a  b   dbm_lt (Lt a) (Le b)" |
  "a < b   dbm_lt (Lt a) (Lt b)"

declare dbm_lt.intros[intro]

definition dbm_le :: "('t::time) DBMEntry  't DBMEntry  bool"
("_  _" [51, 51] 50)
where
  "dbm_le a b  (a  b)  a = b"

text ‹
  Now a valuation is contained in the zone represented by a DBM if it fulfills all individual
  constraints:
›

definition DBM_val_bounded :: "('c  nat)  ('c, 't) cval  ('t::time) DBM  nat  bool"
where
  "DBM_val_bounded v u m n  Le 0  m 0 0 
    ( c. v c  n  (dbm_entry_val u None (Some c) (m 0 (v c))
                       dbm_entry_val u (Some c) None (m (v c) 0)))
     ( c1 c2. v c1  n  v c2  n  dbm_entry_val u (Some c1) (Some c2) (m (v c1) (v c2)))"

abbreviation DBM_val_bounded_abbrev ::
  "('c, 't) cval  ('c  nat)  nat  ('t::time) DBM  bool"
("_ ⊢⇘_,_ _")
where
  "uv,n M  DBM_val_bounded v u M n"

abbreviation
  "dmin a b  if a  b then a else b"

lemma dbm_le_dbm_min:
  "a  b  a = dmin a b" unfolding dbm_le_def
by auto

lemma dbm_lt_asym:
  assumes "e  f"
  shows "~ f  e"
using assms
proof (safe, cases e f rule: dbm_lt.cases, goal_cases)
  case 1 from this(2) show ?case using 1(3-) by (cases f e rule: dbm_lt.cases) auto
next
  case 2 from this(2) show ?case using 2(3-) by (cases f e rule: dbm_lt.cases) auto
next
  case 3 from this(2) show ?case using 3(3-) by (cases f e rule: dbm_lt.cases) auto
next
  case 4 from this(2) show ?case using 4(3-) by (cases f e rule: dbm_lt.cases) auto
next
  case 5 from this(2) show ?case using 5(3-) by (cases f e rule: dbm_lt.cases) auto
next
  case 6 from this(2) show ?case using 6(3-) by (cases f e rule: dbm_lt.cases) auto
qed

lemma dbm_le_dbm_min2:
  "a  b  a = dmin b a"
using dbm_lt_asym by (auto simp: dbm_le_def)

lemma dmb_le_dbm_entry_bound_inf:
  "a  b  a =   b = "
apply (auto simp: dbm_le_def)
  apply (cases rule: dbm_lt.cases)
by auto

lemma dbm_not_lt_eq: "¬ a  b  ¬ b  a  a = b"
apply (cases a)
  apply (cases b, fastforce+)+
done

lemma dbm_not_lt_impl: "¬ a  b  b  a  a = b" using dbm_not_lt_eq by auto

lemma "dmin a b = dmin b a"
proof (cases "a  b")
  case True thus ?thesis by (simp add: dbm_lt_asym)
next
  case False thus ?thesis by (simp add: dbm_not_lt_eq)
qed

lemma dbm_lt_trans: "a  b  b  c  a  c"
proof (cases a b rule: dbm_lt.cases, goal_cases)
  case 1 thus ?case by simp
next
  case 2 from this(2-) show ?case by (cases rule: dbm_lt.cases) simp+
next
  case 3 from this(2-) show ?case by (cases rule: dbm_lt.cases) simp+
next
  case 4 from this(2-) show ?case by (cases rule: dbm_lt.cases) auto
next
  case 5 from this(2-) show ?case by (cases rule: dbm_lt.cases) auto
next
  case 6 from this(2-) show ?case by (cases rule: dbm_lt.cases) auto
next
  case 7 from this(2-) show ?case by (cases rule: dbm_lt.cases) auto
qed

lemma aux_3: "¬ a  b  ¬ b  c  a  c  c = a"
proof goal_cases
  case 1 thus ?case
  proof (cases "c  b")
    case True
    with a  c have "a  b" by (rule dbm_lt_trans)
    thus ?thesis using 1 by auto
  next
    case False thus ?thesis using dbm_not_lt_eq 1 by auto
  qed
qed

inductive_cases[elim!]: "  x"

lemma dbm_lt_asymmetric[simp]: "x  y  y  x  False"
by (cases x y rule: dbm_lt.cases) (auto elim: dbm_lt.cases)

lemma le_dbm_le: "Le a  Le b  a  b" unfolding dbm_le_def by (auto elim: dbm_lt.cases)

lemma le_dbm_lt: "Le a  Lt b  a < b" unfolding dbm_le_def by (auto elim: dbm_lt.cases)

lemma lt_dbm_le: "Lt a  Le b  a  b" unfolding dbm_le_def by (auto elim: dbm_lt.cases)

lemma lt_dbm_lt: "Lt a  Lt b  a  b" unfolding dbm_le_def by (auto elim: dbm_lt.cases)

lemma not_dbm_le_le_impl: "¬ Le a  Le b  a  b" by (metis dbm_lt.intros(3) not_less)

lemma not_dbm_lt_le_impl: "¬ Lt a  Le b  a > b" by (metis dbm_lt.intros(5) not_less)

lemma not_dbm_lt_lt_impl: "¬ Lt a  Lt b  a  b" by (metis dbm_lt.intros(6) not_less)

lemma not_dbm_le_lt_impl: "¬ Le a  Lt b  a  b" by (metis dbm_lt.intros(4) not_less)

(*>*)

(*<*)

fun dbm_add :: "('t::time) DBMEntry  't DBMEntry  't DBMEntry" (infixl "" 70)
where
  "dbm_add      _      = " |
  "dbm_add _           = " |
  "dbm_add (Le a) (Le b) = (Le (a+b))" |
  "dbm_add (Le a) (Lt b) = (Lt (a+b))" |
  "dbm_add (Lt a) (Le b) = (Lt (a+b))" |
  "dbm_add (Lt a) (Lt b) = (Lt (a+b))"

thm dbm_add.simps

lemma aux_4: "x  y  ¬ dbm_add x z  dbm_add y z  dbm_add x z = dbm_add y z"
by (cases x y rule: dbm_lt.cases) ((cases z), auto)+

lemma aux_5: "¬ x  y  dbm_add x z  dbm_add y z  dbm_add y z = dbm_add x z"
proof -
  assume lt: "dbm_add x z  dbm_add y z" "¬ x  y"
  hence "x = y  y  x" by (auto simp: dbm_not_lt_eq)
  thus ?thesis
  proof
    assume "x = y" thus ?thesis by simp
  next
    assume "y  x"
    thus ?thesis
    proof (cases y x rule: dbm_lt.cases, goal_cases)
      case 1 thus ?case using lt by auto
    next
      case 2 thus ?case using lt by auto
    next
      case 3 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
    next
      case 4 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
    next
      case 5 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
    next
      case 6 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
    qed
  qed
qed

lemma aux_42: "x  y  ¬ dbm_add z x  dbm_add z y  dbm_add z x = dbm_add z y"
by (cases x y rule: dbm_lt.cases) ((cases z), auto)+

lemma aux_52: "¬ x  y  dbm_add z x  dbm_add z y  dbm_add z y = dbm_add z x"
proof -
  assume lt: "dbm_add z x  dbm_add z y" "¬ x  y"
  hence "x = y  y  x" by (auto simp: dbm_not_lt_eq)
  thus ?thesis
  proof
    assume "x = y" thus ?thesis by simp
  next
    assume "y  x"
    thus ?thesis
    proof (cases y x rule: dbm_lt.cases, goal_cases)
      case 1 thus ?case using lt by (cases z) fastforce+
    next
      case 2 thus ?case using lt by (cases z) fastforce+
    next
      case 3 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
    next
      case 4 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
    next
      case 5 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
    next
      case 6 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
    qed
  qed
qed

lemma dbm_add_not_inf:
  "a    b    dbm_add a b  "
by (cases a, auto, cases b, auto, cases b, auto)

lemma dbm_le_not_inf:
  "a  b  b    a  "
by (cases "a = b") (auto simp: dbm_le_def)

section ‹DBM Entries Form a Linearly Ordered Abelian Monoid›

instantiation DBMEntry :: (time) linorder
begin
  definition less_eq: "(≤)  dbm_le"
  definition less: "(<) = dbm_lt"
  instance
  proof ((standard; unfold less less_eq), goal_cases)
    case 1 thus ?case unfolding dbm_le_def using dbm_lt_asymmetric by auto
  next
    case 2 thus ?case by (simp add: dbm_le_def)
  next
    case 3 thus ?case unfolding dbm_le_def using dbm_lt_trans by auto
  next
    case 4 thus ?case unfolding dbm_le_def using dbm_lt_asymmetric by auto
  next
    case 5 thus ?case unfolding dbm_le_def using dbm_not_lt_eq by auto
  qed
end

instantiation DBMEntry :: (time) linordered_ab_monoid_add
begin
  definition mult: "(+) = dbm_add"
  definition neutral: "neutral = Le 0"
  instance proof ((standard; unfold mult neutral less less_eq), goal_cases)
    case (1 a b c) thus ?case by (cases a; cases b; cases c; auto)
  next
    case (2 a b) thus ?case by (cases a; cases b) auto
  next
    case (3 a b c)
    thus ?case unfolding dbm_le_def
    apply safe
     apply (rule dbm_lt.cases)
          apply assumption
    by (cases c; fastforce)+
  next
    case (4 x) thus ?case by (cases x) auto
  next
    case (5 x) thus ?case by (cases x) auto
  qed
end

interpretation linordered_monoid: linordered_ab_monoid_add dbm_add dbm_le dbm_lt "Le 0"
  apply (standard, fold neutral mult less_eq less)
using add.commute add.commute add_left_mono assoc by auto

lemma Le_Le_dbm_lt_D[dest]: "Le a  Lt b  a < b" by (cases rule: dbm_lt.cases) auto
lemma Le_Lt_dbm_lt_D[dest]: "Le a  Le b  a < b" by (cases rule: dbm_lt.cases) auto
lemma Lt_Le_dbm_lt_D[dest]: "Lt a  Le b  a  b" by (cases rule: dbm_lt.cases) auto
lemma Lt_Lt_dbm_lt_D[dest]: "Lt a  Lt b  a < b" by (cases rule: dbm_lt.cases) auto

lemma Le_le_LeI[intro]: "a  b  Le a  Le b" unfolding less_eq dbm_le_def by auto
lemma Lt_le_LeI[intro]: "a  b  Lt a  Le b" unfolding less_eq dbm_le_def by auto
lemma Lt_le_LtI[intro]: "a  b  Lt a  Lt b" unfolding less_eq dbm_le_def by auto
lemma Le_le_LtI[intro]: "a < b  Le a  Lt b" unfolding less_eq dbm_le_def by auto
lemma Lt_lt_LeI: "x  y  Lt x < Le y" unfolding less by auto

lemma Le_le_LeD[dest]: "Le a  Le b  a  b" unfolding dbm_le_def less_eq by auto
lemma Le_le_LtD[dest]: "Le a  Lt b  a < b" unfolding dbm_le_def less_eq by auto
lemma Lt_le_LeD[dest]: "Lt a  Le b  a  b" unfolding less_eq dbm_le_def by auto
lemma Lt_le_LtD[dest]: "Lt a  Lt b  a  b" unfolding less_eq dbm_le_def by auto

lemma inf_not_le_Le[simp]: "  Le x = False" unfolding less_eq dbm_le_def by auto
lemma inf_not_le_Lt[simp]: "  Lt x = False" unfolding less_eq dbm_le_def by auto
lemma inf_not_lt[simp]: "  x = False" by auto

lemma any_le_inf: "x  " by (metis less_eq dmb_le_dbm_entry_bound_inf le_cases)


section ‹Basic Properties of DBMs›

subsection ‹DBMs and Length of Paths›

lemma dbm_entry_val_add_1: "dbm_entry_val u (Some c) (Some d) a   dbm_entry_val u (Some d) None b
        dbm_entry_val u (Some c) None (dbm_add a b)"
proof (cases a, goal_cases)
  case 1 thus ?thesis
  apply (cases b)
    apply auto
   using add_mono_thms_linordered_semiring(1) apply fastforce
  using add_le_less_mono by fastforce
next
  case 2 thus ?thesis
  apply (cases b)
    apply auto
   apply (simp add: dbm_entry_val.intros(3) diff_less_eq less_le_trans)
  by (metis add_le_less_mono dbm_entry_val.intros(3) diff_add_cancel less_imp_le)
next
  case 3 thus ?thesis by (cases b) auto
qed

lemma dbm_entry_val_add_2: "dbm_entry_val u None (Some c) a  dbm_entry_val u (Some c) (Some d) b
        dbm_entry_val u None (Some d) (dbm_add a b)"
proof (cases a, goal_cases)
  case 1 thus ?thesis
  apply (cases b)
    apply auto
   using add_mono_thms_linordered_semiring(1) apply fastforce
  using add_le_less_mono by fastforce
next
  case 2 thus ?thesis
  apply (cases b)
    apply auto
   using add_mono_thms_linordered_field(3) apply fastforce
  using add_strict_mono by fastforce
next
  case 3 thus ?thesis by (cases b) auto
qed

lemma dbm_entry_val_add_3:
  "dbm_entry_val u (Some c) (Some d) a   dbm_entry_val u (Some d) (Some e) b
    dbm_entry_val u (Some c) (Some e) (dbm_add a b)"
proof (cases a, goal_cases)
  case 1 thus ?thesis
  apply (cases b)
    apply auto
   using add_mono_thms_linordered_semiring(1) apply fastforce
  using add_le_less_mono by fastforce
next
  case 2 thus ?thesis
  apply (cases b)
    apply auto
   using add_mono_thms_linordered_field(3) apply fastforce
  using add_strict_mono by fastforce
next
  case 3 thus ?thesis by (cases b) auto
qed

lemma dbm_entry_val_add_4:
  "dbm_entry_val u (Some c) None a  dbm_entry_val u None (Some d) b
    dbm_entry_val u (Some c) (Some d) (dbm_add a b)"
proof (cases a, goal_cases)
  case 1 thus ?thesis
  apply (cases b)
    apply auto
   using add_mono_thms_linordered_semiring(1) apply fastforce
  using add_le_less_mono by fastforce
next
  case 2 thus ?thesis
  apply (cases b)
    apply auto
   using add_mono_thms_linordered_field(3) apply fastforce
  using add_strict_mono by fastforce
next
  case 3 thus ?thesis by (cases b) auto
qed

no_notation dbm_add (infixl "" 70)

lemma DBM_val_bounded_len_1'_aux:
  assumes "DBM_val_bounded v u m n" "v c  n" " k  set vs. k > 0  k  n  ( c. v c = k)"
  shows "dbm_entry_val u (Some c) None (len m (v c) 0 vs)" using assms
proof (induction vs arbitrary: c)
  case Nil then show ?case unfolding DBM_val_bounded_def by auto
next
  case (Cons k vs)
  then obtain c' where c': "k > 0" "k  n" "v c' = k" by auto
  with Cons have "dbm_entry_val u (Some c') None (len m (v c') 0 vs)" by auto
  moreover have "dbm_entry_val u (Some c) (Some c') (m (v c) (v c'))" using Cons.prems c'
  by (auto simp add: DBM_val_bounded_def)
  ultimately have "dbm_entry_val u (Some c) None (m (v c) (v c') + len m (v c') 0 vs)"
  using dbm_entry_val_add_1 unfolding mult by fastforce
  with c' show ?case unfolding DBM_val_bounded_def by simp
qed

lemma DBM_val_bounded_len_3'_aux:
  "DBM_val_bounded v u m n  v c  n  v d  n   k  set vs. k > 0  k  n  ( c. v c = k)
    dbm_entry_val u (Some c) (Some d) (len m (v c) (v d) vs)"
proof (induction vs arbitrary: c)
  case Nil thus ?case unfolding DBM_val_bounded_def by auto
next
  case (Cons k vs)
  then obtain c' where c': "k > 0" "k  n" "v c' = k" by auto
  with Cons have "dbm_entry_val u (Some c') (Some d) (len m (v c') (v d) vs)" by auto
  moreover have "dbm_entry_val u (Some c) (Some c') (m (v c) (v c'))" using Cons.prems c'
  by (auto simp add: DBM_val_bounded_def)
  ultimately have "dbm_entry_val u (Some c) (Some d) (m (v c) (v c') + len m (v c') (v d) vs)"
  using dbm_entry_val_add_3 unfolding mult by fastforce
  with c' show ?case unfolding DBM_val_bounded_def by simp
qed

lemma DBM_val_bounded_len_2'_aux:
  "DBM_val_bounded v u m n  v c  n   k  set vs. k > 0  k  n  ( c. v c = k)
   dbm_entry_val u None (Some c) (len m 0 (v c) vs)"
proof (cases vs, goal_cases)
  case 1 then show ?thesis unfolding DBM_val_bounded_def by auto
next
  case (2 k vs)
  then obtain c' where c': "k > 0" "k  n" "v c' = k" by auto
  with 2 have "dbm_entry_val u (Some c') (Some c) (len m (v c') (v c) vs)"
  using DBM_val_bounded_len_3'_aux by auto
  moreover have "dbm_entry_val u None (Some c') (m 0 (v c'))"
  using 2 c' by (auto simp add: DBM_val_bounded_def)
  ultimately have "dbm_entry_val u None (Some c) (m 0 (v c') + len m (v c') (v c) vs)"
  using dbm_entry_val_add_2 unfolding mult by fastforce
  with 2(4) c' show ?case unfolding DBM_val_bounded_def by simp
qed

lemma cnt_0_D:
  "cnt x xs = 0  x  set xs"
apply (induction xs)
 apply simp
apply (rename_tac a xs)
apply (case_tac "x = a")
by simp+

lemma cnt_at_most_1_D:
  "cnt x (xs @ x # ys)  1  x  set xs  x  set ys"
apply (induction xs)
  apply auto[]
  using cnt_0_D apply force
 apply (rename_tac a xs)
 apply (case_tac "a = x")
  apply simp
 apply simp
done

lemma nat_list_0 [intro]:
  "x  set xs  0  set (xs :: nat list)  x > 0"
by (induction xs) auto

lemma DBM_val_bounded_len':
  fixes v
  defines "vo  λ k. if k = 0 then None else Some (SOME c. v c = k)"
  assumes "DBM_val_bounded v u m n" "cnt 0 (i # j # vs)  1"
          " k  set (i # j # vs). k > 0  k  n  ( c. v c = k)"
  shows "dbm_entry_val u (vo i) (vo j) (len m i j vs)"
proof -
  show ?thesis
  proof (cases " k  set vs. k > 0")
    case True
    with assms have *: " k  set vs. k > 0  k  n  ( c. v c = k)" by auto
    show ?thesis
    proof (cases "i = 0")
      case True
      then have i: "vo i = None" by (simp add: vo_def)
      show ?thesis
      proof (cases "j = 0")
        case True with assms i = 0 show ?thesis by auto
      next
        case False
        with assms obtain c2 where c2: "j  n" "v c2 = j" "vo j = Some c2"
        unfolding vo_def by (fastforce intro: someI)
        with i = 0 i DBM_val_bounded_len_2'_aux[OF assms(2) _ *] show ?thesis by auto
      qed
    next
      case False
      with assms(4) obtain c1 where c1: "i  n" "v c1 = i" "vo i = Some c1"
      unfolding vo_def by (fastforce intro: someI)
      show ?thesis
      proof (cases "j = 0")
        case True
        with DBM_val_bounded_len_1'_aux[OF assms(2) _ *] c1 show ?thesis by (auto simp: vo_def)
      next
        case False
        with assms obtain c2 where c2: "j  n" "v c2 = j" "vo j = Some c2"
        unfolding vo_def by (fastforce intro: someI)
        with c1 DBM_val_bounded_len_3'_aux[OF assms(2) _ _ *] show ?thesis by auto
      qed
    qed
  next
    case False
    then have " k  set vs. k = 0" by auto
    then obtain us ws where vs: "vs = us @ 0 # ws" by (meson split_list_last) 
    with cnt_at_most_1_D[of 0 "i # j # us"] assms(3) have
      "0  set us" "0  set ws" "i  0" "j  0"
    by auto
    with vs have vs: "vs = us @ 0 # ws" " k  set us. k > 0" " k  set ws. k > 0" by auto
    with assms(4) have v:
      "kset us. 0 < k  k  n  (c. v c = k)" "kset ws. 0 < k  k  n  (c. v c = k)"
    by auto
    from i  0 j  0 assms obtain c1 c2 where
      c1: "i  n" "v c1 = i" "vo i = Some c1" and c2: "j  n" "v c2 = j" "vo j = Some c2"
    unfolding vo_def by (fastforce intro: someI)
    with dbm_entry_val_add_4 [OF DBM_val_bounded_len_1'_aux[OF assms(2) _ v(1)] DBM_val_bounded_len_2'_aux[OF assms(2) _ v(2)]]
    have "dbm_entry_val u (Some c1) (Some c2) (dbm_add (len m (v c1) 0 us) (len m 0 (v c2) ws))" by auto
    moreover from vs have "len m (v c1) (v c2) vs = dbm_add (len m (v c1) 0 us) (len m 0 (v c2) ws)"
    by (simp add: len_comp mult)
    ultimately show ?thesis using c1 c2 by auto
  qed
qed

lemma DBM_val_bounded_len'1:
  fixes v
  assumes "DBM_val_bounded v u m n" "0  set vs" "v c  n"
          " k  set vs. k > 0  k  n  ( c. v c = k)"
  shows "dbm_entry_val u (Some c) None (len m (v c) 0 vs)"
using DBM_val_bounded_len_1'_aux[OF assms(1,3)] assms(2,4) by fastforce

lemma DBM_val_bounded_len'2:
  fixes v
  assumes "DBM_val_bounded v u m n" "0  set vs" "v c  n"
          " k  set vs. k > 0  k  n  ( c. v c = k)"
  shows "dbm_entry_val u None (Some c) (len m 0 (v c) vs)"
using DBM_val_bounded_len_2'_aux[OF assms(1,3)] assms(2,4) by fastforce

lemma DBM_val_bounded_len'3:
  fixes v
  assumes "DBM_val_bounded v u m n" "cnt 0 vs  1" "v c1  n" "v c2  n"
          " k  set vs. k > 0  k  n  ( c. v c = k)"
  shows "dbm_entry_val u (Some c1) (Some c2) (len m (v c1) (v c2) vs)"
proof -
  show ?thesis
  proof (cases " k  set vs. k > 0")
    case True
    with assms have " k  set vs. k > 0  k  n  ( c. v c = k)" by auto
    with DBM_val_bounded_len_3'_aux[OF assms(1,3,4)] show ?thesis by auto
  next
    case False
    then have " k  set vs. k = 0" by auto
    then obtain us ws where vs: "vs = us @ 0 # ws" by (meson split_list_last) 
    with cnt_at_most_1_D[of 0 "us"] assms(2) have
      "0  set us" "0  set ws"
    by auto
    with vs have vs: "vs = us @ 0 # ws" " k  set us. k > 0" " k  set ws. k > 0" by auto
    with assms(5) have v:
      "kset us. 0 < k  k  n  (c. v c = k)" "kset ws. 0 < k  k  n  (c. v c = k)"
    by auto
    with dbm_entry_val_add_4 [OF DBM_val_bounded_len_1'_aux[OF assms(1,3) v(1)] DBM_val_bounded_len_2'_aux[OF assms(1,4) v(2)]]
    have "dbm_entry_val u (Some c1) (Some c2) (dbm_add (len m (v c1) 0 us) (len m 0 (v c2) ws))" by auto
    moreover from vs have "len m (v c1) (v c2) vs = dbm_add (len m (v c1) 0 us) (len m 0 (v c2) ws)"
    by (simp add: len_comp mult)
    ultimately show ?thesis by auto
  qed
qed

lemma DBM_val_bounded_len'':
  fixes v
  defines "vo  λ k. if k = 0 then None else Some (SOME c. v c = k)"
  assumes "DBM_val_bounded v u m n" "i  0  j  0"
          " k  set (i # j # vs). k > 0  k  n  ( c. v c = k)"
  shows "dbm_entry_val u (vo i) (vo j) (len m i j vs)" using assms
proof (induction "length vs" arbitrary: i vs rule: less_induct)
  case less
  show ?case
  proof (cases " k  set vs. k > 0")
    case True
    with less.prems have *: " k  set vs. k > 0  k  n  ( c. v c = k)" by auto
    show ?thesis
    proof (cases "i = 0")
      case True
      then have i: "vo i = None" by (simp add: vo_def)
      show ?thesis
      proof (cases "j = 0")
        case True with less.prems i = 0 show ?thesis by auto
      next
        case False
        with less.prems obtain c2 where c2: "j  n" "v c2 = j" "vo j = Some c2"
        unfolding vo_def by (fastforce intro: someI)
        with i = 0 i DBM_val_bounded_len_2'_aux[OF less.prems(1) _ *] show ?thesis by auto
      qed
    next
      case False
      with less.prems obtain c1 where c1: "i  n" "v c1 = i" "vo i = Some c1"
      unfolding vo_def by (fastforce intro: someI)
      show ?thesis
      proof (cases "j = 0")
        case True
        with DBM_val_bounded_len_1'_aux[OF less.prems(1) _ *] c1 show ?thesis by (auto simp: vo_def)
      next
        case False
        with less.prems obtain c2 where c2: "j  n" "v c2 = j" "vo j = Some c2"
        unfolding vo_def by (fastforce intro: someI)
        with c1 DBM_val_bounded_len_3'_aux[OF less.prems(1) _ _ *] show ?thesis by auto
      qed
    qed
  next
    case False
    then have " us ws. vs = us @ 0 # ws  ( k  set us. k > 0)"
    proof (induction vs)
      case Nil then show ?case by auto
    next
      case (Cons x vs)
      show ?case
      proof (cases "x = 0")
        case True then show ?thesis by fastforce
      next
        case False
        with Cons.prems have "¬ (aset vs. 0 < a)" by auto
        from Cons.IH[OF this] obtain us ws where "vs = us @ 0 # ws" "aset us. 0 < a" by auto
        with False have "x # vs = (x # us) @ 0 # ws" "aset (x # us). 0 < a" by auto
        then show ?thesis by blast
      qed
    qed
    then obtain us ws where vs: "vs = us @ 0 # ws" " k  set us. k > 0" by blast
    then show ?thesis
oops

lemma DBM_val_bounded_len_1: "DBM_val_bounded v u m n  v c  n   c  set cs. v c  n
       dbm_entry_val u (Some c) None (len m (v c) 0 (map v cs))"
proof (induction cs arbitrary: c)
  case Nil thus ?case unfolding DBM_val_bounded_def by auto
next
  case (Cons c' cs)
  hence "dbm_entry_val u (Some c') None (len m (v c') 0 (map v cs))" by auto
  moreover have "dbm_entry_val u (Some c) (Some c') (m (v c) (v c'))" using Cons.prems
  by (simp add: DBM_val_bounded_def)
  ultimately have "dbm_entry_val u (Some c) None (m (v c) (v c') + len m (v c') 0 (map v cs))"
  using dbm_entry_val_add_1 unfolding mult by fastforce
  thus ?case unfolding DBM_val_bounded_def by simp
qed

lemma DBM_val_bounded_len_3: "DBM_val_bounded v u m n  v c  n  v d  n   c  set cs. v c  n
       dbm_entry_val u (Some c) (Some d) (len m (v c) (v d) (map v cs))"
proof (induction cs arbitrary: c)
  case Nil thus ?case unfolding DBM_val_bounded_def by auto
next
  case (Cons c' cs)
  hence "dbm_entry_val u (Some c') (Some d) (len m (v c') (v d) (map v cs))" by auto
  moreover have "dbm_entry_val u (Some c) (Some c') (m (v c) (v c'))" using Cons.prems
  by (simp add: DBM_val_bounded_def)
  ultimately have "dbm_entry_val u (Some c) (Some d) (m (v c) (v c') + len m (v c') (v d) (map v cs))"
  using dbm_entry_val_add_3 unfolding mult by fastforce
  thus ?case unfolding DBM_val_bounded_def by simp
qed

lemma DBM_val_bounded_len_2: "DBM_val_bounded v u m n  v c  n   c  set cs. v c  n
       dbm_entry_val u None (Some c) (len m 0 (v c) (map v cs))"
proof (cases cs, goal_cases)
  case 1 thus ?thesis unfolding DBM_val_bounded_def by auto
next
  case (2 c' cs)
  hence "dbm_entry_val u (Some c') (Some c) (len m (v c') (v c) (map v cs))"
  using DBM_val_bounded_len_3 by auto
  moreover have "dbm_entry_val u None (Some c') (m 0 (v c'))"
  using 2 by (simp add: DBM_val_bounded_def)
  ultimately have "dbm_entry_val u None (Some c) (m 0 (v c') + len m (v c') (v c) (map v cs))"
  using dbm_entry_val_add_2 unfolding mult by fastforce
  thus ?case using 2(4) unfolding DBM_val_bounded_def by simp 
qed

end

Theory Paths_Cycles

theory Paths_Cycles
  imports Floyd_Warshall Timed_Automata
begin

chapter ‹Library for Paths, Arcs and Lengths›

lemma length_eq_distinct:
  assumes "set xs = set ys" "distinct xs" "length xs = length ys"
  shows "distinct ys"
using assms card_distinct distinct_card by fastforce

section ‹Arcs›

fun arcs :: "nat  nat  nat list  (nat * nat) list" where
  "arcs a b [] = [(a,b)]" |
  "arcs a b (x # xs) = (a, x) # arcs x b xs"

definition arcs' :: "nat list  (nat * nat) set" where
  "arcs' xs = set (arcs (hd xs) (last xs) (butlast (tl xs)))"

lemma arcs'_decomp:
  "length xs > 1  (i, j)  arcs' xs   zs ys. xs = zs @ i # j # ys"
proof (induction xs)
  case Nil thus ?case by auto
next
  case (Cons x xs)
  then have "length xs > 0" by auto
  then obtain y ys where xs: "xs = y # ys" by (metis Suc_length_conv less_imp_Suc_add)
  show ?case
  proof (cases "(i, j) = (x, y)")
    case True
    with xs have "x # xs = [] @ i # j # ys" by simp
    then show ?thesis by auto
  next
    case False
    then show ?thesis
    proof (cases "length ys > 0", goal_cases)
      case 2
      then have "ys = []" by auto
      then have "arcs' (x#xs) = {(x,y)}" using xs by (auto simp add: arcs'_def)
      with Cons.prems(2) 2(1) show ?case by auto
    next
      case True
      with xs Cons.prems(2) False have "(i, j)  arcs' xs" by (auto simp add: arcs'_def)
      with Cons.IH[OF _ this] True xs obtain zs ys where "xs = zs @ i # j # ys" by auto
      then have "x # xs = (x # zs) @ i # j # ys" by simp
      then show ?thesis by blast
    qed
  qed
qed

lemma arcs_decomp_tail:
  "arcs j l (ys @ [i]) = arcs j i ys @ [(i, l)]"
by (induction ys arbitrary: j) auto

lemma arcs_decomp: "xs = ys @ y # zs  arcs x z xs = arcs x y ys @ arcs y z zs"
by (induction ys arbitrary: x xs) simp+

lemma distinct_arcs_ex:
  "distinct xs  i  set xs  xs  []   a b. a  x  (a,b)  set (arcs i j xs)"
 apply (induction xs arbitrary: i)
  apply simp
 apply (rename_tac a xs i)
 apply (case_tac xs)
  apply simp
  apply metis
by auto

lemma cycle_rotate_2_aux:
  "(i, j)  set (arcs a b (xs @ [c]))  (i,j)  (c,b)  (i, j)  set (arcs a c xs)"
by (induction xs arbitrary: a) auto

lemma arcs_set_elem1:
  assumes "j  k" "k  set (i # xs)"
  shows " l. (k, l)  set (arcs i j xs)" using assms
by (induction xs arbitrary: i) auto

lemma arcs_set_elem2:
  assumes "i  k" "k  set (j # xs)"
  shows " l. (l, k)  set (arcs i j xs)" using assms
proof (induction xs arbitrary: i)
  case Nil then show ?case by simp
next
  case (Cons x xs)
  then show ?case by (cases "k = x") auto
qed

section ‹Length of Paths›

lemmas (in linordered_ab_monoid_add) comm = add.commute

lemma len_add:
  fixes M :: "('a :: linordered_ab_monoid_add) mat"
  shows "len M i j xs + len M i j xs = len (λi j. M i j + M i j) i j xs"
proof (induction xs arbitrary: i j)
  case Nil thus ?case by auto
next
  case (Cons x xs)
  have "M i x + len M x j xs + (M i x + len M x j xs) = M i x + (len M x j xs + M i x) + len M x j xs"
  by (simp add: assoc)
  also have " = M i x + (M i x + len M x j xs) + len M x j xs" by (simp add: comm)
  also have " = (M i x + M i x) + (len M x j xs + len M x j xs)" by (simp add: assoc)
  finally have "M i x + len M x j xs + (M i x + len M x j xs)
                = (M i x + M i x) + len (λi j. M i j + M i j) x j xs"
  using Cons by simp
  thus ?case by simp
qed

section ‹Canonical Matrices›

abbreviation
  "canonical M n   i j k. i  n  j  n  k  n  M i k  M i j + M j k"

lemma fw_canonical:
 "cycle_free m n  canonical (fw m n n n n) n"
proof (clarify, goal_cases)
  case 1
  with fw_shortest[OF ‹cycle_free m n] show ?case
  by auto
qed

lemma canonical_len:
  "canonical M n  i  n  j  n  set xs  {0..n}  M i j  len M i j xs"
proof (induction xs arbitrary: i)
  case Nil thus ?case by auto
next
  case (Cons x xs)
  then have "M x j  len M x j xs" by auto
  from Cons.prems ‹canonical M n have "M i j  M i x + M x j" by simp
  also with Cons have "  M i x + len M x j xs" by (simp add: add_mono)
  finally show ?case by simp
qed

section ‹Cycle Rotation›

lemma cycle_rotate:
  fixes M :: "('a :: linordered_ab_monoid_add) mat"
  assumes "length xs > 1" "(i, j)  arcs' xs"
  shows " ys zs. len M a a xs = len M i i (j # ys @ a # zs)  xs = zs @ i # j # ys" using assms
proof -
  assume A: "length xs > 1" "(i, j)  arcs' xs"
  from arcs'_decomp[OF this] obtain ys zs where xs: "xs = zs @ i # j # ys" by blast
  from len_decomp[OF this, of M a a]
  have "len M a a xs = len M a i zs + len M i a (j # ys)" .
  also have " = len M i a (j # ys) + len M a i zs" by (simp add: comm)
  also from len_comp[of M i i "j # ys" a zs] have " = len M i i (j # ys @ a # zs)" by auto
  finally show ?thesis using xs by auto
qed

lemma cycle_rotate_2:
  fixes M :: "('a :: linordered_ab_monoid_add) mat"
  assumes "xs  []" "(i, j)  set (arcs a a xs)"
  shows " ys. len M a a xs = len M i i (j # ys)  set ys  set (a # xs)  length ys < length xs"
using assms proof -
  assume A:"xs  []" "(i, j)  set (arcs a a xs)"
  { fix ys assume A:"a = i" "xs = j # ys"
    then have ?thesis by auto
  } note * = this
  { fix b ys assume A:"a = j" "xs = ys @ [i]"
    then have ?thesis
    proof (auto, goal_cases)
      case 1
      have "len M j j (ys @ [i]) = M i j + len M j i ys"
      using len_decomp[of "ys @ [i]" ys i "[]" M j j] by (auto simp: comm)
      thus ?case by blast
    qed
  } note ** = this
  { assume "length xs = 1"
    then obtain b where xs: "xs = [b]" by (metis One_nat_def length_0_conv length_Suc_conv) 
    with A(2) have "a = i  b = j  a = j  b = i" by auto
    then have ?thesis using * ** xs by auto
  } note *** = this
  show ?thesis
  proof (cases "length xs = 0")
    case True with A show ?thesis by auto
  next
    case False
    thus ?thesis
    proof (cases "length xs = 1", goal_cases)
      case True with *** show ?thesis by auto
    next
      case 2
      hence "length xs > 1" by linarith
      then obtain b c ys where ys:"xs = b # ys @ [c]"
      by (metis One_nat_def assms(1) 2(2) length_0_conv length_Cons list.exhaust rev_exhaust) 
      thus ?thesis
      proof (cases "(i,j) = (a,b)", goal_cases)
        case True
        with ys * show ?thesis by auto
      next
        case False
        then show ?thesis
        proof (cases "(i,j) = (c,a)", goal_cases)
          case True
          with ys ** show ?thesis by auto
        next
          case 2
          with A(2) ys have "(i, j)  arcs' xs"
          using cycle_rotate_2_aux by (auto simp: arcs'_def) (* slow *)
          from cycle_rotate[OF ‹length xs > 1 this, of M a] show ?thesis by auto
        qed
      qed
    qed
  qed
qed

lemma cycle_rotate_len_arcs:
  fixes M :: "('a :: linordered_ab_monoid_add) mat"
  assumes "length xs > 1" "(i, j)  arcs' xs"
  shows " ys zs. len M a a xs = len M i i (j # ys @ a # zs)
                 set (arcs a a xs) = set (arcs i i (j # ys @ a # zs))  xs = zs @ i # j # ys"
using assms
proof -
  assume A: "length xs > 1" "(i, j)  arcs' xs"
  from arcs'_decomp[OF this] obtain ys zs where xs: "xs = zs @ i # j # ys" by blast
  from len_decomp[OF this, of M a a]
  have "len M a a xs = len M a i zs + len M i a (j # ys)" .
  also have " = len M i a (j # ys) + len M a i zs" by (simp add: comm)
  also from len_comp[of M i i "j # ys" a zs] have " = len M i i (j # ys @ a # zs)" by auto
  finally show ?thesis
  using xs arcs_decomp[OF xs, of a a] arcs_decomp[of "j # ys @ a # zs" "j # ys" a zs i i] by force
qed

lemma cycle_rotate_2':
  fixes M :: "('a :: linordered_ab_monoid_add) mat"
  assumes "xs  []" "(i, j)  set (arcs a a xs)"
  shows " ys. len M a a xs = len M i i (j # ys)  set (i # j # ys) = set (a # xs)
              1 + length ys = length xs  set (arcs a a xs) = set (arcs i i (j # ys))"
proof -
  note A = assms
  { fix ys assume A:"a = i" "xs = j # ys"
    then have ?thesis by auto
  } note * = this
  { fix b ys assume A:"a = j" "xs = ys @ [i]"
    then have ?thesis
    proof (auto, goal_cases)
      case 1
      have "len M j j (ys @ [i]) = M i j + len M j i ys"
      using len_decomp[of "ys @ [i]" ys i "[]" M j j] by (auto simp: comm)
      moreover have "arcs j j (ys @ [i]) = arcs j i ys @ [(i, j)]" using arcs_decomp_tail by auto
      ultimately show ?case by auto
    qed
  } note ** = this
  { assume "length xs = 1"
    then obtain b where xs: "xs = [b]" by (metis One_nat_def length_0_conv length_Suc_conv) 
    with A(2) have "a = i  b = j  a = j  b = i" by auto
    then have ?thesis using * ** xs by auto
  } note *** = this
  show ?thesis
  proof (cases "length xs = 0")
    case True with A show ?thesis by auto
  next
    case False
    thus ?thesis
    proof (cases "length xs = 1", goal_cases)
      case True with *** show ?thesis by auto
    next
      case 2
      hence "length xs > 1" by linarith
      then obtain b c ys where ys:"xs = b # ys @ [c]"
      by (metis One_nat_def assms(1) 2(2) length_0_conv length_Cons list.exhaust rev_exhaust) 
      thus ?thesis
      proof (cases "(i,j) = (a,b)")
        case True
        with ys * show ?thesis by blast
      next
        case False
        then show ?thesis
        proof (cases "(i,j) = (c,a)", goal_cases)
          case True
          with ys ** show ?thesis by force
        next
          case 2
          with A(2) ys have "(i, j)  arcs' xs"
          using cycle_rotate_2_aux by (auto simp add: arcs'_def) (* slow *)
          from cycle_rotate_len_arcs[OF ‹length xs > 1 this, of M a] show ?thesis by auto
        qed
      qed
    qed
  qed
qed

section ‹Equivalent Characterizations of Cycle-Freeness›

lemma negative_cycle_dest_diag:
  "¬ cycle_free M n   i xs. i  n  set xs  {0..n}  len M i i xs < 𝟭"
proof (auto simp: cycle_free_def, goal_cases)
  case (1 i xs j)
  from this(4) have "len M i j xs < len M i j (rem_cycles i j xs)" by auto
  from negative_cycle_dest[OF this] obtain i' ys
  where *:"len M i' i' ys < 𝟭" "set (i' # ys)  set (i # j # xs)" by auto
  from this(2) 1(1-3) have "set ys  {0..n}" "i'  n" by auto
  with * show ?case by auto
next
  case 2 then show ?case by fastforce
qed

abbreviation cyc_free :: "('a::linordered_ab_monoid_add) mat  nat  bool" where
  "cyc_free m n   i xs. i  n  set xs  {0..n}  len m i i xs  𝟭"

lemma cycle_free_diag_intro:
  "cyc_free M n  cycle_free M n"
using negative_cycle_dest_diag by force

lemma cycle_free_diag_equiv:
  "cyc_free M n  cycle_free M n" using negative_cycle_dest_diag
by (force simp: cycle_free_def)

lemma cycle_free_diag_dest:
  "cycle_free M n  cyc_free M n"
using cycle_free_diag_equiv by blast

lemma cyc_free_diag_dest:
  assumes "cyc_free M n" "i  n" "set xs  {0..n}"
  shows "len M i i xs  𝟭"
using assms by auto

lemma cycle_free_0_0:
  fixes M :: "('a::linordered_ab_monoid_add) mat"
  assumes "cycle_free M n"
  shows "M 0 0  𝟭"
using cyc_free_diag_dest[OF cycle_free_diag_dest[OF assms], of 0 "[]"] by auto

section ‹More Theorems Related to Floyd-Warshall›

lemma D_cycle_free_len_dest:
  "cycle_free m n
      i  n.  j  n. D m i j n = m' i j  i  n  j  n  set xs  {0..n}
      ys. set ys  {0..n}  len m' i j xs = len m i j ys"
proof (induction xs arbitrary: i)
  case Nil
  with Nil have "m' i j = D m i j n" by simp
  from D_dest''[OF this]
  obtain ys where "set ys  {0..n}" "len m' i j [] = len m i j ys"
  by auto
  then show ?case by auto
next
  case (Cons y ys)
  from Cons.IH[OF Cons.prems(1,2) _ j  n, of y] Cons.prems(5)
  obtain zs where zs:"set zs  {0..n}" "len m' y j ys = len m y j zs" by auto
  with Cons have "m' i y = D m i y n" by simp
  from D_dest''[OF this] obtain ws where ws:"set ws  {0..n}" "m' i y = len m i y ws" by auto
  with len_comp[of m i j ws y zs] zs Cons.prems(5)
  have "len m' i j (y # ys) = len m i j (ws @ y # zs)" "set (ws @ y # zs)  {0..n}" by auto
  then show ?case by blast
qed

lemma D_cyc_free_preservation:
  "cyc_free m n   i  n.  j  n. D m i j n = m' i j  cyc_free m' n"
proof (auto, goal_cases)
  case (1 i xs)
  from D_cycle_free_len_dest[OF _ 1(2,3,3,4)] 1(1) cycle_free_diag_equiv
  obtain ys where "set ys  {0..n}  len m' i i xs = len m i i ys" by fast
  with 1(1,3) show ?case by auto
qed

abbreviation "FW m n  fw m n n n n"

lemma FW_cyc_free_preservation:
  "cyc_free m n  cyc_free (FW m n) n"
apply (rule D_cyc_free_preservation)
 apply assumption
apply safe
apply (rule fw_shortest_path)
using cycle_free_diag_equiv by auto

lemma cyc_free_diag_dest':
  "cyc_free m n  i  n  m i i  𝟭"
proof goal_cases
  case 1
  then have "i  n  set []  {0..n}" by auto
  with 1(1) have "𝟭  len m i i []" by blast
  then show ?case by auto
qed

lemma FW_diag_neutral_preservation:
  " i  n. M i i = 𝟭  cyc_free M n   in. (FW M n) i i = 𝟭"
proof (auto, goal_cases)
  case (1 i)
  from this(3) have "(FW M n) i i  M i i" by (auto intro: fw_mono)
  with 1 have "(FW M n) i i  𝟭" by auto
  with cyc_free_diag_dest'[OF FW_cyc_free_preservation[OF 1(2)] i  n] show "FW M n i i = 𝟭" by auto
qed  

lemma FW_fixed_preservation:
  fixes M :: "('a::linordered_ab_monoid_add) mat"
  assumes A: "i  n" "M 0 i + M i 0 = 𝟭" "canonical (FW M n) n" "cyc_free (FW M n) n"
  shows "FW M n 0 i + FW M n i 0 = 𝟭" using assms
proof -
  let ?M' = "FW M n"
  assume A: "i  n" "M 0 i + M i 0 = 𝟭" "canonical ?M' n" "cyc_free ?M' n"
  from i  n have "?M' 0 i + ?M' i 0  M 0 i + M i 0" by (auto intro: fw_mono add_mono)
  with A(2) have "?M' 0 i + ?M' i 0  𝟭" by auto
  moreover from ‹canonical ?M' n i  n
  have "?M' 0 0  ?M' 0 i + ?M' i 0" by auto
  moreover from cyc_free_diag_dest'[OF  ‹cyc_free ?M' n] have "𝟭  ?M' 0 0" by simp
  ultimately show "?M' 0 i + ?M' i 0 = 𝟭" by (auto simp: add_mono)
qed

lemma diag_cyc_free_neutral:
  "cyc_free M n  kn. M k k  𝟭  in. M i i = 𝟭"
proof (clarify, goal_cases)
  case (1 i)
  note A = this
  then have "i  n  set []  {0..n}" by auto
  with A(1) have "𝟭  M i i" by fastforce
  with A(2) i  n show "M i i = 𝟭" by auto
qed

lemma fw_upd_canonical_id:
  "canonical M n  i  n  j  n  k  n  fw_upd M k i j = M"
proof (auto simp: fw_upd_def upd_def less_eq[symmetric] min.coboundedI2, goal_cases)
  case 1
  then have "M i j  M i k + M k j" by auto
  then have "min (M i j) (M i k + M k j) = M i j" by (simp split: split_min)
  thus ?case by force
qed

lemma fw_canonical_id:
  "canonical M n  i  n  j  n  k  n  fw M n k i j = M"
proof (induction k arbitrary: i j)
  case 0
  then show ?case
  proof (induction i arbitrary: j)
    case 0
    then show ?case
    proof (induction j)
      case 0 thus ?case by (auto intro: fw_upd_canonical_id)
    next
      case Suc thus ?case by (auto intro: fw_upd_canonical_id)
    qed
  next
    case Suc
    then show ?case
    proof (induction j)
      case 0 thus ?case by (auto intro: fw_upd_canonical_id)
    next
      case Suc thus ?case by (auto intro: fw_upd_canonical_id)
    qed
  qed
next
  case Suc
  then show ?case
  proof (induction i arbitrary: j)
    case 0
    then show ?case
    proof (induction j)
      case 0 thus ?case by (auto intro: fw_upd_canonical_id)
    next
      case Suc thus ?case by (auto intro: fw_upd_canonical_id)
    qed
  next
    case Suc
    then show ?case
    proof (induction j)
      case 0 thus ?case by (auto intro: fw_upd_canonical_id)
    next
      case Suc thus ?case by (auto intro: fw_upd_canonical_id)
    qed
  qed
qed

lemmas FW_canonical_id = fw_canonical_id[OF _ order.refl order.refl order.refl]

section ‹Helper Lemmas for Bouyer's Theorem on Approximation›

lemma aux1: "i  n  j  n  set xs  {0..n}  (a,b)  set (arcs i j xs)  a  n  b  n"
by (induction xs arbitrary: i) auto

lemma arcs_distinct1:
  "i  set xs  j  set xs  distinct xs  xs  []  (a,b)  set (arcs i j xs)  a  b"
apply (induction xs arbitrary: i)
 apply fastforce
apply (rename_tac a' xs i)
apply (case_tac xs)
 apply auto
done

lemma arcs_distinct2:
  "i  set xs  j  set xs  distinct xs  i  j  (a,b)  set (arcs i j xs)  a  b"
by (induction xs arbitrary: i) auto

lemma arcs_distinct3: "distinct (a # b # c # xs)  (i,j)  set (arcs a b xs)  i  c  j  c"
by (induction xs arbitrary: a) force+

lemma arcs_elem:
  assumes "(a, b)  set (arcs i j xs)" shows "a  set (i # xs)" "b  set (j # xs)"
using assms by (induction xs arbitrary: i) auto

lemma arcs_distinct_dest1:
  "distinct (i # a # zs)  (b,c)  set (arcs a j zs)  b  i"
using arcs_elem by fastforce

lemma arcs_distinct_fix:
  "distinct (a # x # xs @ [b])  (a,c)  set (arcs a b (x # xs))  c = x"
using arcs_elem(1) by fastforce

lemma disjE3: "A  B  C  (A  G)  (B  G)  (C  G)  G"
by auto

lemma arcs_predecessor:
  assumes "(a, b)  set (arcs i j xs)" "a  i"
  shows " c. (c, a)  set (arcs i j xs)" using assms
by (induction xs arbitrary: i) auto

lemma arcs_successor:
  assumes "(a, b)  set (arcs i j xs)" "b  j"
  shows " c. (b,c)  set (arcs i j xs)" using assms
apply (induction xs arbitrary: i)
 apply simp
apply (rename_tac aa xs i)
apply (case_tac xs)
by auto

lemma arcs_predecessor':
  assumes "(a, b)  set (arcs i j (x # xs))" "(a,b)  (i, x)"
  shows " c. (c, a)  set (arcs i j (x # xs))" using assms
by (induction xs arbitrary: i x) auto

lemma arcs_cases:
  assumes "(a, b)  set (arcs i j xs)" "xs  []"
  shows "( ys. xs = b # ys  a = i)  ( ys. xs = ys @ [a]  b = j)
        ( c d ys. (a,b)  set (arcs c d ys)  xs = c # ys @ [d])"
using assms
proof (induction xs arbitrary: i)
  case Nil then show ?case by auto
next
  case (Cons x xs)
  show ?case
  proof (cases "(a, b) = (i, x)")
    case True
    with Cons.prems show ?thesis by auto
  next
    case False
    note F = this
    show ?thesis
    proof (cases "xs = []")
      case True
      with F Cons.prems show ?thesis by auto
    next
      case False
      from F Cons.prems have "(a, b)  set (arcs x j xs)" by auto
      from Cons.IH[OF this False] have
        "(ys. xs = b # ys  a = x)  (ys. xs = ys @ [a]  b = j)
          (c d ys. (a, b)  set (arcs c d ys)  xs = c # ys @ [d])"
      .
      then show ?thesis
      proof (rule disjE3, goal_cases)
        case 1
        from 1 obtain ys where *: "xs = b # ys  a = x" by auto
        show ?thesis
        proof (cases "ys = []")
          case True
          with * show ?thesis by auto
        next
          case False
          then obtain z zs where zs: "ys = zs @ [z]" by (metis append_butlast_last_id) 
          with * show ?thesis by auto
        qed
      next
        case 2 then show ?case by auto
      next
        case 3 with False show ?case by auto
      qed
    qed
  qed
qed

lemma arcs_cases':
  assumes "(a, b)  set (arcs i j xs)" "xs  []"
  shows "( ys. xs = b # ys  a = i)  ( ys. xs = ys @ [a]  b = j)  ( ys zs. xs = ys @ a # b # zs)"
using assms
proof (induction xs arbitrary: i)
  case Nil then show ?case by auto
next
  case (Cons x xs)
  show ?case
  proof (cases "(a, b) = (i, x)")
    case True
    with Cons.prems show ?thesis by auto
  next
    case False
    note F = this
    show ?thesis
    proof (cases "xs = []")
      case True
      with F Cons.prems show ?thesis by auto
    next
      case False
      from F Cons.prems have "(a, b)  set (arcs x j xs)" by auto
      from Cons.IH[OF this False] have
        "(ys. xs = b # ys  a = x)  (ys. xs = ys @ [a]  b = j)
          (ys zs. xs = ys @ a # b # zs)"
      .
      then show ?thesis
      proof (rule disjE3, goal_cases)
        case 1
        from 1 obtain ys where *: "xs = b # ys  a = x" by auto
        show ?thesis
        proof (cases "ys = []")
          case True
          with * show ?thesis by auto
        next
          case False
          then obtain z zs where zs: "ys = zs @ [z]" by (metis append_butlast_last_id) 
          with * show ?thesis by auto
        qed
      next
        case 2 then show ?case by auto
      next
        case 3
        then obtain ys zs where "xs = ys @ a # b # zs" by auto
        then have "x # xs = (x # ys) @ a # b # zs" by auto
        then show ?thesis by blast
      qed
    qed
  qed
qed

lemma arcs_successor':
  assumes "(a, b)  set (arcs i j xs)" "b  j"
  shows " c. xs = [b]  a = i  ( ys. xs = b # c # ys  a = i)  ( ys. xs = ys @ [a,b]  c = j)
        ( ys zs. xs = ys @ a # b # c # zs)"
using assms
proof (induction xs arbitrary: i)
  case Nil then show ?case by auto
next
  case (Cons x xs)
  show ?case
  proof (cases "(a, b) = (i, x)")
    case True
    with Cons.prems show ?thesis by (cases xs) auto
  next
    case False
    note F = this
    show ?thesis
    proof (cases "xs = []")
      case True
      with F Cons.prems show ?thesis by auto
    next
      case False
      from F Cons.prems have "(a, b)  set (arcs x j xs)" by auto
      from Cons.IH[OF this b  j] obtain c where c:
        "xs = [b]  a = x  (ys. xs = b # c # ys  a = x)  (ys. xs = ys @ [a, b]  c = j)
          (ys zs. xs = ys @ a # b # c # zs)"
      ..
      then show ?thesis
      proof (standard, goal_cases)
        case 1 with Cons.prems show ?case by auto
      next
        case 2
        then show ?thesis
        proof (rule disjE3, goal_cases)
          case 1
          from 1 obtain ys where *: "xs = b # ys  a = x" by auto
          show ?thesis
          proof (cases "ys = []")
            case True
            with * show ?thesis by auto
          next
            case False
            then obtain z zs where zs: "ys = z # zs" by (cases ys) auto
            with * show ?thesis by fastforce
          qed
        next
          case 2 then show ?case by auto
        next
          case 3
          then obtain ys zs where "xs = ys @ a # b # c # zs" by auto
          then have "x # xs = (x # ys) @ a # b # c # zs" by auto
          then show ?thesis by blast
        qed
      qed
    qed
  qed
qed

lemma list_last:
  "xs = []  ( y ys. xs = ys @ [y])"
by (induction xs) auto

lemma arcs_predecessor'':
  assumes "(a, b)  set (arcs i j xs)" "a  i"
 shows " c. xs = [a]  ( ys. xs = a # b # ys)  ( ys. xs = ys @ [c,a]  b = j)
        ( ys zs. xs = ys @ c # a # b # zs)"
using assms
proof (induction xs arbitrary: i)
  case Nil then show ?case by auto
next
  case (Cons x xs)
  show ?case
  proof (cases "(a, b) = (i, x)")
    case True
    with Cons.prems show ?thesis by (cases xs) auto
  next
    case False
    note F = this
    show ?thesis
    proof (cases "xs = []")
      case True
      with F Cons.prems show ?thesis by auto
    next
      case False
      from F Cons.prems have *: "(a, b)  set (arcs x j xs)" by auto
      from False obtain y ys where xs: "xs = y # ys" by (cases xs) auto
      show ?thesis
      proof (cases "(a,b) = (x,y)")
        case True with * xs show ?thesis by auto
      next
        case False
        with * xs have **: "(a, b)  set (arcs y j ys)" by auto
        show ?thesis
        proof (cases "ys = []")
          case True with ** xs show ?thesis by force
        next
          case False
          from arcs_cases'[OF ** this] obtain ws zs where ***:
            "ys = b # ws  a = y  ys = ws @ [a]  b = j  ys = ws @ a # b # zs"
          by auto
          then show ?thesis
           apply rule
            using xs apply blast
           apply safe
            using xs list_last[of ws] apply -
            apply (rotate_tac 3)
            apply (case_tac "ws = []")
             apply auto[]
            apply (subgoal_tac "y ys. ws = ys @ [y]")
             apply fastforce
            apply simp
           apply (case_tac "ws = []")
            apply (subgoal_tac "x # xs = [x] @ y # a # b # zs")
             apply (rule exI[where x = y])
             apply blast
            apply simp
           subgoal
           proof goal_cases
             case 1
             then obtain u us where "ws = us @ [u]" by auto
             with 1(1,2) have "x # xs = (x # y # us) @ u # a # b # zs" by auto
             then show ?case by blast
           qed
          done
        qed
      qed
    qed
  qed
qed

lemma arcs_ex_middle:
  " b. (a, b)  set (arcs i j (ys @ a # xs))"
by (induction xs arbitrary: i ys) (auto simp: arcs_decomp)

lemma arcs_ex_head:
  " b. (i, b)  set (arcs i j xs)"
by (cases xs) auto

subsection ‹Successive›

fun successive where
  "successive _ [] = True" |
  "successive P [_] = True" |
  "successive P (x # y # xs)  ¬ P y  successive P xs  ¬ P x  successive P (y # xs)"

lemma "¬ successive (λ x. x > (0 :: nat)) [Suc 0, Suc 0]" by simp
lemma "successive (λ x. x > (0 :: nat)) [Suc 0]" by simp
lemma "successive (λ x. x > (0 :: nat)) [Suc 0, 0, Suc 0]" by simp
lemma "¬ successive (λ x. x > (0 :: nat)) [Suc 0, 0, Suc 0, Suc 0]" by simp
lemma "¬ successive (λ x. x > (0 :: nat)) [Suc 0, 0, 0, Suc 0, Suc 0]" by simp
lemma "successive (λ x. x > (0 :: nat)) [Suc 0, 0, Suc 0, 0, Suc 0]" by simp
lemma "¬ successive (λ x. x > (0 :: nat)) [Suc 0, Suc 0, 0, Suc 0]" by simp
lemma "successive (λ x. x > (0 :: nat)) [0, 0, Suc 0, 0]" by simp

lemma successive_step: "successive P (x # xs)  ¬ P x  successive P xs"
  apply (cases xs)
   apply simp
  apply (rename_tac y ys)
  apply (case_tac ys)
   apply auto
done

lemma successive_step_2: "successive P (x # y # xs)  ¬ P y  successive P xs"
  apply (cases xs)
   apply simp
  apply (rename_tac z zs)
  apply (case_tac zs)
   apply auto
done

lemma successive_stepI:
  "successive P xs  ¬ P x  successive P (x # xs)"
by (cases xs) auto

theorem list_two_induct[case_names Nil Single Cons]:
  fixes P :: "'a list  bool" 
    and list :: "'a list" 
  assumes Nil: "P []"
  assumes Single: " x. P [x]"
    and Cons: "x1 x2 xs. P xs  P (x2 # xs)  P (x1 # x2 # xs)"
  shows "P xs"
using assms
 apply (induction "length xs" arbitrary: xs rule: less_induct)
 apply (rename_tac xs)
 apply (case_tac xs)
  apply simp
 apply (rename_tac ys)
 apply (case_tac ys)
  apply simp
 apply (rename_tac zs)
 apply (case_tac zs)
by auto

lemma successive_end_1:
  "successive P xs  ¬ P x  successive P (xs @ [x])"
by (induction _ xs rule: list_two_induct) auto

lemma successive_ends_1:
  "successive P xs  ¬ P x  successive P ys  successive P (xs @ x # ys)"
by (induction _ xs rule: list_two_induct) (fastforce intro: successive_stepI)+

lemma successive_ends_1':
  "successive P xs  ¬ P x  P y  ¬ P z  successive P ys  successive P (xs @ x # y # z # ys)"
by (induction _ xs rule: list_two_induct) (fastforce intro: successive_stepI)+

lemma successive_end_2:
  "successive P xs  ¬ P x  successive P (xs @ [x,y])"
by (induction _ xs rule: list_two_induct) auto

lemma successive_end_2':
  "successive P (xs @ [x])  ¬ P x  successive P (xs @ [x,y])"
by (induction _ xs rule: list_two_induct) auto

lemma successive_end_3:
  "successive P (xs @ [x])  ¬ P x  P y  ¬ P z  successive P (xs @ [x,y,z])"
by (induction _ xs rule: list_two_induct) auto

lemma successive_step_rev:
  "successive P (xs @ [x])  ¬ P x  successive P xs"
by (induction _ xs rule: list_two_induct) auto

lemma successive_glue:
  "successive P (zs @ [z])  successive P (x # xs)  ¬ P z  ¬ P x  successive P (zs @ [z] @ x # xs)"
proof goal_cases
  case A: 1
  show ?thesis
  proof (cases "P x")
    case False
    with A(1,2) successive_ends_1 successive_step show ?thesis by fastforce
  next
    case True
    with A(1,3) successive_step_rev have "¬ P z" "successive P zs" by fastforce+
    with A(2) successive_ends_1 show ?thesis by fastforce
  qed
qed

lemma successive_glue':
  "successive P (zs @ [y])  ¬ P z  successive P zs  ¬ P y 
   successive P (x # xs)  ¬ P w  successive P xs  ¬ P x
   ¬ P z  ¬ P w  successive P (zs @ y # z # w # x # xs)"
by (metis append_Cons append_Nil successive.simps(3) successive_ends_1 successive_glue successive_stepI)

lemma successive_dest_head:
  "xs = w # x # ys  successive P xs  successive P (x # xs)  ¬ P w  successive P xs  ¬ P x"
by auto

lemma successive_dest_tail:
  "xs = zs @ [y,z]  successive P xs  successive P (zs @ [y])  ¬ P z  successive P zs  ¬ P y"
 apply (induction _ xs arbitrary: zs rule: list_two_induct)
   apply simp+
 apply (rename_tac zs)
 apply (case_tac zs)
  apply simp
 apply (rename_tac ws)
 apply (case_tac ws)
  apply force+
done

lemma successive_split:
  "xs = ys @ zs  successive P xs  successive P ys  successive P zs"
 apply (induction _ xs arbitrary: ys rule: list_two_induct)
   apply simp
  apply (rename_tac ys, case_tac ys)
   apply simp
  apply simp
 apply (rename_tac ys, case_tac ys)
  apply simp
 apply (rename_tac list, case_tac list)
  apply (auto intro: successive_stepI)
done

lemma successive_decomp:
  "xs = x # ys @ zs @ [z]  successive P xs  ¬ P x  ¬ P z  successive P (zs @ [z] @ (x # ys))"
by (metis Cons_eq_appendI successive_glue successive_split)

lemma successive_predecessor:
  assumes "(a, b)  set (arcs i j xs)" "a  i" "successive P (arcs i j xs)" "P (a,b)" "xs  []"
 shows " c. (xs = [a]  c = i  ( ys. xs = a # b # ys  c = i)  ( ys. xs = ys @ [c,a]  b = j)
        ( ys zs. xs = ys @ c # a # b # zs))  ¬ P (c,a)"
proof -
  from arcs_predecessor''[OF assms(1,2)] obtain c where c:
    "xs = [a]  (ys. xs = a # b # ys)  (ys. xs = ys @ [c, a]  b = j)
     (ys zs. xs = ys @ c # a # b # zs)"
  by auto
  then show ?thesis
  proof (safe, goal_cases)
    case 1
    with assms have "arcs i j xs = [(i, a), (a, j)]" by auto
    with assms have "¬ P (i, a)" by auto
    with 1 show ?case by simp
  next
    case 2
    with assms have "¬ P (i, a)" by fastforce
    with 2 show ?case by auto
  next
    case 3
    with assms have "¬ P (c, a)" using arcs_decomp successive_dest_tail by fastforce 
    with 3 show ?case by auto
  next
    case 4
    with assms(3,4) have "¬ P (c, a)" using arcs_decomp successive_split by fastforce
    with 4 show ?case by auto
  qed
qed

thm arcs_successor'

lemma successive_successor:
  assumes "(a, b)  set (arcs i j xs)" "b  j" "successive P (arcs i j xs)" "P (a,b)" "xs  []"
 shows " c. (xs = [b]  c = j  ( ys. xs = b # c # ys)  ( ys. xs = ys @ [a,b]  c = j)
        ( ys zs. xs = ys @ a # b # c # zs))  ¬ P (b,c)"
proof -
  from arcs_successor'[OF assms(1,2)] obtain c where c:
    "xs = [b]  a = i  (ys. xs = b # c # ys  a = i)  (ys. xs = ys @ [a, b]  c = j)
      (ys zs. xs = ys @ a # b # c # zs)"
  ..
  then show ?thesis
  proof (safe, goal_cases)
    case 1
    with assms(1,2) have "arcs i j xs = [(a,b), (b,j)]" by auto
    with assms have "¬ P (b,j)" by auto
    with 1 show ?case by simp
  next
    case 2
    with assms have "¬ P (b, c)" by fastforce
    with 2 show ?case by auto
  next
    case 3
    with assms have "¬ P (b, c)" using arcs_decomp successive_dest_tail by fastforce 
    with 3 show ?case by auto
  next
    case 4
    with assms(3,4) have "¬ P (b, c)" using arcs_decomp successive_split by fastforce
    with 4 show ?case by auto
  qed
qed

lemmas add_mono_right = add_mono[OF order_refl]
lemmas add_mono_left  = add_mono[OF _ order_refl]

subsubsection ‹Obtaining successive and distinct paths›

lemma canonical_successive:
  fixes A B
  defines "M  λ i j. min (A i j) (B i j)"
  assumes "canonical A n"
  assumes "set xs  {0..n}"
  assumes "i  n" "j  n"
  shows " ys. len M i j ys  len M i j xs  set ys  {0..n}
                successive (λ (a, b). M a b = A a b) (arcs i j ys)"
using assms
proof (induction xs arbitrary: i rule: list_two_induct)
  case Nil show ?case by fastforce
next
  case 2: (Single x i)
  show ?case
  proof (cases "M i x = A i x  M x j = A x j")
    case False
    then have "successive (λ(a, b). M a b = A a b) (arcs i j [x])" by auto
    with 2 show ?thesis by blast
  next
    case True
    with 2 have "M i j  M i x + M x j" unfolding min_def by fastforce
    with 2(3-) show ?thesis apply simp apply (rule exI[where x = "[]"]) by auto
  qed
next
  case 3: (Cons x y xs i)
  show ?case
  proof (cases "M i y  M i x + M x y", goal_cases)
    case 1
    from 3 obtain ys where
      "len M i j ys  len M i j (y # xs)  set ys  {0..n}
        successive (λa. case a of (a, b)  M a b = A a b) (arcs i j ys)"
    by fastforce
    moreover from 1 have "len M i j (y # xs)  len M i j (x # y # xs)"
    using add_mono by (auto simp: assoc[symmetric])
    ultimately show ?case by force
  next
    case False
    { assume "M i x = A i x" "M x y = A x y"
      with 3(3-) have "A i y  M i x + M x y" by auto
      then have "M i y  M i x + M x y" unfolding M_def min_def by auto
    } note * = this
    with False have "M i x  A i x  M x y  A x y" by auto
    then show ?thesis
    proof (standard, goal_cases)
      case 1
      from 3 obtain ys where ys:
        "len M x j ys  len M x j (y # xs)" "set ys  {0..n}"
        "successive (λa. case a of (a, b)  M a b = A a b) (arcs x j ys)"
      by force+
      from 1 successive_stepI[OF ys(3), of "(i, x)"] have
        "successive (λa. case a of (a, b)  M a b = A a b) (arcs i j (x # ys))"
      by auto
      moreover have "len M i j (x # ys)  len M i j (x # y # xs)" using add_mono_right[OF ys(1)]
      by auto
      ultimately show ?case using 3(5) ys(2) by fastforce
    next
      case 2
      from 3 obtain ys where ys:
        "len M y j ys  len M y j xs" "set ys  {0..n}"
        "successive (λa. case a of (a, b)  M a b = A a b) (arcs y j ys)"
      by force+
      from this(3) 2 have
        "successive (λa. case a of (a, b)  M a b = A a b) (arcs i j (x # y # ys))" 
      by simp
      moreover from add_mono_right[OF ys(1)] have
        "len M i j (x # y # ys)  len M i j (x # y # xs)"
      by (auto simp: assoc[symmetric])
      ultimately show ?thesis using ys(2) 3(5) by fastforce
    qed
  qed
qed

lemma canonical_successive_distinct:
  fixes A B
  defines "M  λ i j. min (A i j) (B i j)"
  assumes "canonical A n"
  assumes "set xs  {0..n}"
  assumes "i  n" "j  n"
  assumes "distinct xs" "i  set xs" "j  set xs"
  shows " ys. len M i j ys  len M i j xs  set ys  set xs
                successive (λ (a, b). M a b = A a b) (arcs i j ys)
                distinct ys  i  set ys  j  set ys"
using assms
proof (induction xs arbitrary: i rule: list_two_induct)
  case Nil show ?case by fastforce
next
  case 2: (Single x i)
  show ?case
  proof (cases "M i x = A i x  M x j = A x j")
    case False
    then have "successive (λ(a, b). M a b = A a b) (arcs i j [x])" by auto
    with 2 show ?thesis by blast
  next
    case True
    with 2 have "M i j  M i x + M x j" unfolding min_def by fastforce
    with 2(3-) show ?thesis apply simp apply (rule exI[where x = "[]"]) by auto
  qed
next
  case 3: (Cons x y xs i)
  show ?case
  proof (cases "M i y  M i x + M x y")
    case 1: True
    from 3(2)[OF 3(3,4)] 3(5-10) obtain ys where ys:
      "len M i j ys  len M i j (y # xs)" "set ys  set (x # y # xs)"
       "successive (λa. case a of (a, b)  M a b = A a b) (arcs i j ys)"
       "distinct ys  i  set ys  j  set ys"
    by fastforce
    moreover from 1 have "len M i j (y # xs)  len M i j (x # y # xs)"
    using add_mono by (auto simp: assoc[symmetric])
    ultimately have "len M i j ys  len M i j (x # y # xs)" by auto
    then show ?thesis using ys(2-) by blast
  next
    case False
    { assume "M i x = A i x" "M x y = A x y"
      with 3(3-) have "A i y  M i x + M x y" by auto
      then have "M i y  M i x + M x y" unfolding M_def min_def by auto
    } note * = this
    with False have "M i x  A i x  M x y  A x y" by auto
    then show ?thesis
    proof (standard, goal_cases)
      case 1
      from 3(2)[OF 3(3,4)] 3(5-10) obtain ys where ys:
        "len M x j ys  len M x j (y # xs)" "set ys  set (y # xs)"
        "successive (λa. case a of (a, b)  M a b = A a b) (arcs x j ys)"
        "distinct ys" "i  set ys" "x  set ys" "j  set ys" 
      by fastforce
      from 1 successive_stepI[OF ys(3), of "(i, x)"] have
        "successive (λa. case a of (a, b)  M a b = A a b) (arcs i j (x # ys))"
      by auto
      moreover have "len M i j (x # ys)  len M i j (x # y # xs)" using add_mono_right[OF ys(1)]
      by auto
      moreover have "distinct (x # ys)" "i  set (x # ys)" "j  set (x # ys)" using ys(4-) 3(8-)
      by auto
      moreover from ys(2) have "set (x # ys)  set (x # y # xs)" by auto
      ultimately show ?case by fastforce
    next
      case 2
      from 3(1)[OF 3(3,4)] 3(5-) obtain ys where ys:
        "len M y j ys  len M y j xs" "set ys  set xs"
        "successive (λa. case a of (a, b)  M a b = A a b) (arcs y j ys)"
        "distinct ys" "j  set ys" "y  set ys" "i  set ys" "x  set ys"
      by fastforce
      from this(3) 2 have
        "successive (λa. case a of (a, b)  M a b = A a b) (arcs i j (x # y # ys))" 
      by simp
      moreover from add_mono_right[OF ys(1)] have
        "len M i j (x # y # ys)  len M i j (x # y # xs)"
      by (auto simp: assoc[symmetric])
      moreover have "distinct (x # y # ys)" "i  set (x # y # ys)" "j  set (x # y # ys)"
      using ys(4-) 3(8-) by auto
      ultimately show ?thesis using ys(2) by fastforce
    qed
  qed
qed

lemma successive_snd_last: "successive P (xs @ [x, y])  P y  ¬ P x"
by (induction _ xs rule: list_two_induct) auto

lemma canonical_shorten_rotate_neg_cycle:
  fixes A B
  defines "M  λ i j. min (A i j) (B i j)"
  assumes "canonical A n"
  assumes "set xs  {0..n}"
  assumes "i  n"
  assumes "len M i i xs < 𝟭"
  shows " j ys. len M j j ys < 𝟭  set (j # ys)  set (i # xs)
                successive (λ (a, b). M a b = A a b) (arcs j j ys)
                distinct ys  j  set ys 
               (ys  []  M j (hd ys)  A j (hd ys)  M (last ys) j  A (last ys) j)"
using assms
proof -
  note A = assms
  from negative_len_shortest[OF _ A(5)] obtain j ys where ys:
    "distinct (j # ys)" "len M j j ys < 𝟭" "j  set (i # xs)" "set ys  set xs"
  by blast
  from this(1,3) canonical_successive_distinct[OF A(2) subset_trans[OF this(4) A(3)], of j j B] A(3,4)
  obtain zs where zs:
    "len M j j zs  len M j j ys"
    "set zs  set ys" "successive (λ(a, b). M a b = A a b) (arcs j j zs)"
    "distinct zs" "j  set zs"
  by (force simp: M_def)
  show ?thesis
  proof (cases "zs = []")
    assume "zs  []"
    then obtain w ws where ws: "zs = w # ws" by (cases zs) auto
    show ?thesis
    proof (cases "ws = []")
      case False
      then obtain u us where us: "ws = us @ [u]" by (induction ws) auto
      show ?thesis
      proof (cases "M j w = A j w  M u j = A u j")
        case True
        have "u  n" "j  n" "w  n" using us ws zs(2) ys(3,4) A(3,4) by auto
        with A(2) True have "M u w  M u j + M j w" unfolding M_def min_def by fastforce
        then have
          "len M u u (w # us)  len M j j zs"
        using ws us by (simp add: len_comp comm) (auto intro: add_mono simp: assoc[symmetric])
        moreover have "set (u # w # us)  set (i # xs)" using ws us zs(2) ys(3,4) by auto
        moreover have "distinct (w # us)" "u  set (w # us)" using ws us zs(4) by auto
        moreover have "successive (λ(a, b). M a b = A a b) (arcs u u (w # us))"
        proof (cases us)
          case Nil
          with zs(3) ws us True show ?thesis by auto
        next
          case (Cons v vs)
          with zs(3) ws us True have "M w v  A w v" by auto
          with ws us Cons zs(3) True arcs_decomp_tail successive_split show ?thesis by (simp, blast)
        qed
        moreover have "M (last (w # us)) u  A (last (w # us)) u"
        proof (cases "us = []")
          case T: True
          with zs(3) ws us True show ?thesis by auto
        next
          case False
          then obtain v vs where vs: "us = vs @ [v]" by (induction us) auto
          with ws us have "arcs j j zs = arcs j v (w # vs) @ [(v, u), (u,j)]" by (simp add: arcs_decomp)
          with zs(3) True have "M v u  A v u"
          using successive_snd_last[of "λ(a, b). M a b = A a b" "arcs j v (w # vs)"] by auto
          with vs show ?thesis by simp
        qed
        ultimately show ?thesis using zs(1) ys(2)
        by (intro exI[where x = u], intro exI[where x = "w # us"]) fastforce
      next
        case False
        with zs ws us ys show ?thesis by (intro exI[where x = j], intro exI[where x = "zs"]) auto
      qed
    next
      case True
      with True ws zs ys show ?thesis by (intro exI[where x = j], intro exI[where x = "zs"]) fastforce
    qed
  next
    case True
    with ys zs show ?thesis by (intro exI[where x = j], intro exI[where x = "zs"]) fastforce
  qed
qed

(* Generated by sledgehammer/z3 *)
lemma successive_arcs_extend_last:
  "successive P (arcs i j xs)  ¬ P (i, hd xs)  ¬ P (last xs, j)  xs  []
   successive P (arcs i j xs @ [(i, hd xs)])"
proof -
  assume a1: "¬ P (i, hd xs)  ¬ P (last xs, j)"
  assume a2: "successive P (arcs i j xs)"
  assume a3: "xs  []"
  then have f4: "¬ P (last xs, j)  successive P (arcs i (last xs) (butlast xs))"
    using a2 by (metis (no_types) append_butlast_last_id arcs_decomp_tail successive_step_rev)
  have f5: "arcs i j xs = arcs i (last xs) (butlast xs) @ [(last xs, j)]"
    using a3 by (metis (no_types) append_butlast_last_id arcs_decomp_tail)
  have "([] @ arcs i j xs @ [(i, hd xs)]) @ [(i, hd xs)] = arcs i j xs @ [(i, hd xs), (i, hd xs)]"
    by simp
  then have "P (last xs, j)  successive P (arcs i j xs @ [(i, hd xs)])"
    using a2 a1 by (metis (no_types) self_append_conv2 successive_end_2 successive_step_rev)
  then show ?thesis
    using f5 f4 successive_end_2 by fastforce
qed

lemma cycle_rotate_arcs:
  fixes M :: "('a :: linordered_ab_monoid_add) mat"
  assumes "length xs > 1" "(i, j)  arcs' xs"
  shows " ys zs. set (arcs a a xs) = set (arcs i i (j # ys @ a # zs))  xs = zs @ i # j # ys" using assms
proof -
  assume A: "length xs > 1" "(i, j)  arcs' xs"
  from arcs'_decomp[OF this] obtain ys zs where xs: "xs = zs @ i # j # ys" by blast
  with arcs_decomp[OF this, of a a] arcs_decomp[of "j # ys @ a # zs" "j # ys" a zs i i]
  show ?thesis by force
qed

lemma cycle_rotate_len_arcs_successive:
  fixes M :: "('a :: linordered_ab_monoid_add) mat"
  assumes "length xs > 1" "(i, j)  arcs' xs" "successive P (arcs a a xs)" "¬ P (a, hd xs)  ¬ P (last xs, a)"
  shows " ys zs. len M a a xs = len M i i (j # ys @ a # zs)
                 set (arcs a a xs) = set (arcs i i (j # ys @ a # zs))  xs = zs @ i # j # ys
                 successive P (arcs i i (j # ys @ a # zs))"
using assms
proof -
  note A = assms
  from arcs'_decomp[OF A(1,2)] obtain ys zs where xs: "xs = zs @ i # j # ys" by blast
  note arcs1 = arcs_decomp[OF xs, of a a]
  note arcs2 = arcs_decomp[of "j # ys @ a # zs" "j # ys" a zs i i]
  have *:"successive P (arcs i i (j # ys @ a # zs))"
  proof (cases "ys = []")
    case True
    show ?thesis
    proof (cases zs)
      case Nil
      with A(3,4) xs True show ?thesis by auto
    next
      case (Cons z zs')
      with True arcs2 A(3,4) xs show ?thesis apply simp
      by (metis arcs.simps(1,2) arcs1 successive.simps(3) successive_split successive_step) 
    qed
  next
    case False
    then obtain y ys' where ys: "ys = ys' @ [y]" by (metis append_butlast_last_id)
    show ?thesis
    proof (cases zs)
      case Nil
      with A(3,4) xs ys have
        "¬ P (a, i)  ¬ P (y, a)" "successive P (arcs a a (i # j # ys' @ [y]))"
      by simp+
      from successive_decomp[OF _ this(2,1)] show ?thesis using ys Nil arcs_decomp by fastforce
    next
      case (Cons z zs')
      with A(3,4) xs ys have
        "¬ P (a, z)  ¬ P (y, a)" "successive P (arcs a a (z # zs' @ i # j # ys' @ [y]))"
      by simp+
      from successive_decomp[OF _ this(2,1)] show ?thesis using ys Cons arcs_decomp by fastforce
    qed
  qed
  from len_decomp[OF xs, of M a a] have "len M a a xs = len M a i zs + len M i a (j # ys)" .
  also have " = len M i a (j # ys) + len M a i zs" by (simp add: comm)
  also from len_comp[of M i i "j # ys" a zs] have " = len M i i (j # ys @ a # zs)" by auto
  finally show ?thesis
  using * xs arcs_decomp[OF xs, of a a] arcs_decomp[of "j # ys @ a # zs" "j # ys" a zs i i] by force
qed

lemma successive_successors:
  "xs = ys @ a # b # c # zs  successive P (arcs i j xs)  ¬ P (a,b)  ¬ P (b, c)"
 apply (induction _ xs arbitrary: i ys rule: list_two_induct)
   apply fastforce
  apply fastforce
 apply (rename_tac ys, case_tac ys)
  apply fastforce
 apply (rename_tac list, case_tac list)
  apply fastforce+
done

lemma successive_successors':
  "xs = ys @ a # b # zs  successive P xs  ¬ P a  ¬ P b"
using successive_split by fastforce

lemma cycle_rotate_len_arcs_successive':
  fixes M :: "('a :: linordered_ab_monoid_add) mat"
  assumes "length xs > 1" "(i, j)  arcs' xs" "successive P (arcs a a xs)"
          "¬ P (a, hd xs)  ¬ P (last xs, a)"
  shows " ys zs. len M a a xs = len M i i (j # ys @ a # zs)
                 set (arcs a a xs) = set (arcs i i (j # ys @ a # zs))  xs = zs @ i # j # ys
                 successive P (arcs i i (j # ys @ a # zs) @ [(i,j)])"
using assms
proof -
  note A = assms
  from arcs'_decomp[OF A(1,2)] obtain ys zs where xs: "xs = zs @ i # j # ys" by blast
  note arcs1 = arcs_decomp[OF xs, of a a]
  note arcs2 = arcs_decomp[of "j # ys @ a # zs" "j # ys" a zs i i]
  have *:"successive P (arcs i i (j # ys @ a # zs) @ [(i,j)])"
  proof (cases "ys = []")
    case True
    show ?thesis
    proof (cases zs)
      case Nil
      with A(3,4) xs True show ?thesis by auto
    next
      case (Cons z zs')
      with True arcs2 A(3,4) xs show ?thesis
       apply simp
       apply (cases "P (a, z)")
        apply (simp add: arcs_decomp)
        apply (simp only: append_Cons[symmetric])
        using successive_split[of "((a, z) # arcs z i zs') @ [(i, j), (j, a)]" _ "[(j, a)]" P]
        apply auto[]
       subgoal (* Generated by sledgehammer *)
       proof simp
         assume a1: "successive P ((a, z) # arcs z a (zs' @ [i, j]))"
         assume a2: "¬ P (a, z)"
         assume a3: "zs = z # zs'"
         assume a4: "ys = []"
         assume a5: "xs = z # zs' @ [i, j]"
         have f6: "p pa ps. ¬ successive p ((pa::nat × nat) # ps)  p pa  successive p ps"
           by (meson successive_step)
         have "(a, z) # arcs z i zs' @ (i, j) # arcs j a [] = arcs a a xs"
           using a4 a3 by (simp add: arcs1)
         then have "arcs z a (zs' @ [i, j]) = arcs z i zs' @ [(i, j), (j, a)]"
           using a5 by simp
         then show
           "¬ P (j, a)  successive P ((a, z) # arcs z i zs' @ [(i, j)])
           ¬ P (i, j)  (successive P (arcs z i zs' @ [(i, j)])
           ¬ P (j, a)  successive P ((a, z) # arcs z i zs' @ [(i, j)]))"
         using f6 a2 a1
         by (metis successive.simps(1) successive_dest_tail successive_ends_1 successive_stepI)
       qed
      done
    qed  
  next
    case False
    then obtain y ys' where ys: "ys = ys' @ [y]" by (metis append_butlast_last_id)
    show ?thesis
    proof (cases zs)
      case Nil
      with A(3,4) xs ys have *:
        "¬ P (a, i)  ¬ P (y, a)" "successive P (arcs a a (i # j # ys' @ [y]))"
      by simp+
      from successive_decomp[OF _ this(2,1)] ys Nil arcs_decomp have
        "successive P (arcs i i (j # ys @ a # zs))"
      by fastforce
      moreover from * have "¬ P (a, i)  ¬ P (i, j)" by auto
      ultimately show ?thesis
      by (metis append_Cons last_snoc list.distinct(1) list.sel(1) Nil successive_arcs_extend_last)
    next
      case (Cons z zs')
      with A(3,4) xs ys have *:
        "¬ P (a, z)  ¬ P (y, a)" "successive P (arcs a a (z # zs' @ i # j # ys' @ [y]))"
        by simp_all
      from successive_decomp[OF _ this(2,1)] ys Cons arcs_decomp have **:
        "successive P (arcs i i (j # ys @ a # zs))"
        by fastforce
      from Cons have "zs  []" by auto
      then obtain w ws where ws: "zs = ws @ [w]" by (induction zs) auto
      with A(3,4) xs ys have *:
        "successive P (arcs a a (ws @ [w] @ i # j # ys' @ [y]))"
        by simp
      from successive_successors[OF _ *] have "¬ P (w, i)  ¬ P (i, j)" by auto
      with * show ?thesis
        by (metis ** append_is_Nil_conv last.simps last_append list.distinct(2) list.sel(1)
                successive_arcs_extend_last ws) 
    qed
  qed
  from len_decomp[OF xs, of M a a] have "len M a a xs = len M a i zs + len M i a (j # ys)" .
  also have " = len M i a (j # ys) + len M a i zs" by (simp add: comm)
  also from len_comp[of M i i "j # ys" a zs] have " = len M i i (j # ys @ a # zs)" by auto
  finally show ?thesis
  using * xs arcs_decomp[OF xs, of a a] arcs_decomp[of "j # ys @ a # zs" "j # ys" a zs i i] by force
qed

lemma cycle_rotate_3:
  fixes M :: "('a :: linordered_ab_monoid_add) mat"
  assumes "xs  []" "(i, j)  set (arcs a a xs)" "successive P (arcs a a xs)" "¬ P (a, hd xs)  ¬ P (last xs, a)"
  shows " ys. len M a a xs = len M i i (j # ys)  set (i # j # ys) = set (a # xs)  1 + length ys = length xs
              set (arcs a a xs) = set (arcs i i (j # ys))
              successive P (arcs i i (j # ys))"
proof -
  note A = assms
  { fix ys assume A:"a = i" "xs = j # ys"
    with assms(3) have ?thesis by auto
  } note * = this
  have **: ?thesis if A: "a = j" "xs = ys @ [i]" for ys using A
  proof (safe, goal_cases)
    case 1
    have "len M j j (ys @ [i]) = M i j + len M j i ys"
    using len_decomp[of "ys @ [i]" ys i "[]" M j j] by (auto simp: comm)
    moreover have "arcs j j (ys @ [i]) = arcs j i ys @ [(i, j)]" using arcs_decomp_tail by auto
    moreover with assms(3,4) A have "successive P ((i,j) # arcs j i ys)"
     apply simp
     apply (case_tac ys)
      apply simp
     apply simp
    by (metis arcs.simps(2) calculation(2) 1(1) successive_split successive_step)
    ultimately show ?case by auto
  qed
  { assume "length xs = 1"
    then obtain b where xs: "xs = [b]" by (metis One_nat_def length_0_conv length_Suc_conv) 
    with A(2) have "a = i  b = j  a = j  b = i" by auto
    then have ?thesis using * ** xs by auto
  } note *** = this
  show ?thesis
  proof (cases "length xs = 0")
    case True with A show ?thesis by auto
  next
    case False
    thus ?thesis
    proof (cases "length xs = 1", goal_cases)
      case True with *** show ?thesis by auto
    next
      case 2
      hence "length xs > 1" by linarith
      then obtain b c ys where ys:"xs = b # ys @ [c]"
      by (metis One_nat_def assms(1) 2(2) length_0_conv length_Cons list.exhaust rev_exhaust) 
      thus ?thesis
      proof (cases "(i,j) = (a,b)")
        case True
        with ys * show ?thesis by blast
      next
        case False
        then show ?thesis
        proof (cases "(i,j) = (c,a)", goal_cases)
          case True
          with ys ** show ?thesis by force
        next
          case 2
          with A(2) ys have "(i, j)  arcs' xs"
          using cycle_rotate_2_aux by (auto simp add: arcs'_def) (* slow *)
          from cycle_rotate_len_arcs_successive[OF ‹length xs > 1 this A(3,4), of M] show ?thesis
          by auto
        qed
      qed
    qed
  qed
qed

lemma cycle_rotate_3':
  fixes M :: "('a :: linordered_ab_monoid_add) mat"
  assumes "xs  []" "(i, j)  set (arcs a a xs)" "successive P (arcs a a xs)" "¬ P (a, hd xs)  ¬ P (last xs, a)"
  shows " ys. len M a a xs = len M i i (j # ys)  set (i # j # ys) = set (a # xs)  1 + length ys = length xs
              set (arcs a a xs) = set (arcs i i (j # ys))
              successive P (arcs i i (j # ys) @ [(i, j)])"
proof -
  note A = assms
  have *: ?thesis if "a = i" "xs = j # ys" for ys
  using that assms(3) successive_arcs_extend_last[OF assms(3,4)] by auto
  have **: ?thesis if A:"a = j" "xs = ys @ [i]" for ys
  using A proof (auto, goal_cases)
    case 1
    have "len M j j (ys @ [i]) = M i j + len M j i ys"
    using len_decomp[of "ys @ [i]" ys i "[]" M j j] by (auto simp: comm)
    moreover have "arcs j j (ys @ [i]) = arcs j i ys @ [(i, j)]" using arcs_decomp_tail by auto
    moreover with assms(3,4) A have "successive P ((i,j) # arcs j i ys @ [(i, j)])"
     apply simp
     apply (case_tac ys)
      apply simp
     apply simp
    by (metis successive_step)
    ultimately show ?case by auto
  qed
  { assume "length xs = 1"
    then obtain b where xs: "xs = [b]" by (metis One_nat_def length_0_conv length_Suc_conv) 
    with A(2) have "a = i  b = j  a = j  b = i" by auto
    then have ?thesis using * ** xs by auto
  } note *** = this
  show ?thesis
  proof (cases "length xs = 0")
    case True with A show ?thesis by auto
  next
    case False
    thus ?thesis
    proof (cases "length xs = 1", goal_cases)
      case True with *** show ?thesis by auto
    next
      case 2
      hence "length xs > 1" by linarith
      then obtain b c ys where ys:"xs = b # ys @ [c]"
      by (metis One_nat_def assms(1) 2(2) length_0_conv length_Cons list.exhaust rev_exhaust) 
      thus ?thesis
      proof (cases "(i,j) = (a,b)")
        case True
        with ys * show ?thesis by blast
      next
        case False
        then show ?thesis
        proof (cases "(i,j) = (c,a)", goal_cases)
          case True
          with ys ** show ?thesis by force
        next
          case 2
          with A(2) ys have "(i, j)  arcs' xs"
          using cycle_rotate_2_aux by (auto simp add: arcs'_def) (* slow *)
          from cycle_rotate_len_arcs_successive'[OF ‹length xs > 1 this A(3,4), of M] show ?thesis
          by auto
        qed
      qed
    qed
  qed
qed

end

Theory DBM_Basics

theory DBM_Basics
  imports DBM Paths_Cycles
begin

fun get_const where
  "get_const (Le c) = c" |
  "get_const (Lt c) = c" |
  "get_const  = undefined"


subsection ‹Discourse on updating DBMs›

abbreviation DBM_update :: "('t::time) DBM  nat  nat  ('t DBMEntry)  ('t::time) DBM"
where
  "DBM_update M m n v  (λ x y. if m = x  n = y then v else M x y)"
  
fun DBM_upd :: "('t::time) DBM  (nat  nat  't DBMEntry)  nat  nat  nat  't DBM"
where
  "DBM_upd M f 0 0 _ = DBM_update M 0 0 (f 0 0)" |
  "DBM_upd M f (Suc i) 0 n = DBM_update (DBM_upd M f i n n) (Suc i) 0 (f (Suc i) 0)" |
  "DBM_upd M f i (Suc j) n = DBM_update (DBM_upd M f i j n) i (Suc j) (f i (Suc j))"
  
lemma upd_1:
assumes "j  n"
shows "DBM_upd M1 f (Suc m) n N (Suc m) j = DBM_upd M1 f (Suc m) j N (Suc m) j"
using assms
by (induction n) auto

lemma upd_2:
assumes "i  m"
shows "DBM_upd M1 f (Suc m) n N i j = DBM_upd M1 f (Suc m) 0 N i j"
using assms
proof (induction n)
  case 0 thus ?case by blast
next
  case (Suc n)
  thus ?case by simp
qed

lemma upd_3:
assumes "m  N" "n  N" "j  n" "i  m"
shows "(DBM_upd M1 f m n N) i j = (DBM_upd M1 f i j N) i j"
using assms
proof (induction m arbitrary: n i j, goal_cases)
  case (1 n) thus ?case by (induction n) auto
next
  case (2 m n i j) thus ?case
  proof (cases "i = Suc m")
    case True thus ?thesis using upd_1[OF j  n] by blast
    next
    case False
    with i  Suc m have "i  m" by auto
    with upd_2[OF this] have "DBM_upd M1 f (Suc m) n N i j = DBM_upd M1 f m N N i j" by force
    also have " = DBM_upd M1 f i j N i j" using False 2 by force
    finally show ?thesis .
  qed
qed

lemma upd_id:
  assumes "m  N" "n  N" "i  m" "j  n"
  shows "(DBM_upd M1 f m n N) i j = f i j"
proof -
  from assms upd_3 have "DBM_upd M1 f m n N i j = DBM_upd M1 f i j N i j" by blast
  also have " = f i j" by (cases i; cases j; fastforce)
  finally show ?thesis .
qed


subsection ‹Zones and DBMs›

definition DBM_zone_repr :: "('t::time) DBM  ('c  nat)  nat  ('c, 't :: time) zone"
("[_]⇘_,_" [72,72,72] 72)
where
  "[M]v,n = {u . DBM_val_bounded v u M n}"

lemma dbm_entry_val_mono_1:
  "dbm_entry_val u (Some c) (Some c') b  b  b'  dbm_entry_val u (Some c) (Some c') b'"
proof (induction b, goal_cases)
  case 1 thus ?case using le_dbm_le le_dbm_lt by (induction b'; fastforce)
next
  case 2 thus ?case using lt_dbm_le lt_dbm_lt by (induction b'; fastforce)
next
  case 3 thus ?case unfolding dbm_le_def by auto
qed

lemma dbm_entry_val_mono_2:
  "dbm_entry_val u None (Some c) b  b  b'  dbm_entry_val u None (Some c) b'"
proof (induction b, goal_cases)
  case 1 thus ?case using le_dbm_le le_dbm_lt by (induction b'; fastforce)
next
  case 2 thus ?case using lt_dbm_le lt_dbm_lt by (induction b'; fastforce)
next
  case 3 thus ?case unfolding dbm_le_def by auto
qed

lemma dbm_entry_val_mono_3:
  "dbm_entry_val u (Some c) None b  b  b'  dbm_entry_val u (Some c) None b'"
proof (induction b, goal_cases)
  case 1 thus ?case using le_dbm_le le_dbm_lt by (induction b'; fastforce)
next
  case 2 thus ?case using lt_dbm_le lt_dbm_lt by (induction b'; fastforce)
next
  case 3 thus ?case unfolding dbm_le_def by auto
qed

lemma DBM_le_subset:
  " i j. i  n  j  n  M i j  M' i j  u  [M]v,n  u  [M']v,n"
proof -
  assume A: "i j. i  n  j  n  M i j  M' i j" "u  [M]v,n"
  hence "DBM_val_bounded v u M n" by (simp add: DBM_zone_repr_def)
  with A(1) have "DBM_val_bounded v u M' n" unfolding DBM_val_bounded_def
  proof (auto, goal_cases)
    case 1 from this(1,2) show ?case unfolding less_eq[symmetric] by fastforce
  next
    case (2 c)
    hence "dbm_entry_val u None (Some c) (M 0 (v c))" "M 0 (v c)  M' 0 (v c)" by auto
    thus ?case using dbm_entry_val_mono_2 by fast
  next
    case (3 c)
    hence "dbm_entry_val u (Some c) None (M (v c) 0)" "M (v c) 0  M' (v c) 0" by auto
    thus ?case using dbm_entry_val_mono_3 by fast 
  next
    case (4 c1 c2)
    hence "dbm_entry_val u (Some c1) (Some c2) (M (v c1) (v c2))" "M (v c1) (v c2)  M' (v c1) (v c2)"
    by auto
    thus ?case using dbm_entry_val_mono_1 by fast
  qed
  thus "u  [M']v,n" by (simp add: DBM_zone_repr_def)
qed


subsection ‹DBMs Without Negative Cycles are Non-Empty›

text ‹
  We need all of these assumptions for the proof that matrices without negative cycles
  represent non-negative zones:
    * Abelian (linearly ordered) monoid
    * Time is non-trivial
    * Time is dense
›
lemmas (in linordered_ab_monoid_add) comm = add.commute

lemma sum_gt_neutral_dest':
  "(a :: (('a :: time) DBMEntry))  𝟭  a + b > 𝟭   d. Le d  a  Le (-d)  b  d  0"
proof -
  assume "a + b > 𝟭" "a  𝟭"
  show ?thesis
  proof (cases "b  𝟭")
    case True
    with a  𝟭 show ?thesis by (auto simp: neutral)
  next
    case False
    hence "b < Le 0" by (auto simp: neutral)
    with a  𝟭 a + b > 𝟭 show ?thesis
    proof (cases a, cases b, auto simp: neutral, goal_cases)
      case (1 a' b')
      from 1(2) have "a' + b' > 0" by (auto elim: dbm_lt.cases simp: less mult)
      hence "b' > -a'" by (metis add.commute diff_0 diff_less_eq)
      with ‹Le 0  Le a' show ?case
      by (auto simp: dbm_le_def less_eq le_dbm_le)
    next
      case (2 a' b')
      from this(2) have "a' + b' > 0" by (auto elim: dbm_lt.cases simp: less mult)
      hence "b' > -a'" by (metis add.commute diff_0 diff_less_eq)
      with ‹Le 0  Le a' show ?case
      by (auto simp: dbm_le_def less_eq le_dbm_le)
    next
      case (3 a') thus ?case by (auto simp: dbm_le_def less_eq)
    next
      case (4 a')
      thus ?case
      proof (cases b, auto, goal_cases)
        case (1 b')
        have "b' < 0" using 1(2) by (metis dbm_lt.intros(3) less less_asym neqE)
        from 1 have "a' + b' > 0" by (auto elim: dbm_lt.cases simp: less mult)
        then have "-b' < a'" by (metis diff_0 diff_less_eq)
        with b' < 0 show ?case by (auto simp: dbm_le_def less_eq)
      next
        case (2 b')
        then have A: "b'  0" "a' > 0" by (auto elim: dbm_lt.cases simp: less less_eq dbm_le_def)
        show ?case
        proof (cases "b' = 0")
          case True
          from dense[OF A(2)] obtain d where d: "d > 0" "d < a'" by auto
          then have "Le (-d) < Lt b'" "Le d < Lt a'" unfolding less using True by auto
          with d(1) show ?thesis by - (rule exI[where x = "d"], auto)
        next
          case False
          with A(1) have *: "- b' > 0" by simp
          from 2 have "a' + b' > 0" by (auto elim: dbm_lt.cases simp: less mult)
          then have "-b' < a'" by (metis less_add_same_cancel1 minus_add_cancel minus_less_iff) 
          from dense[OF this] obtain d where d:
            "d > -b'" "-d < b'" "d < a'"
          by (auto simp add: minus_less_iff)
          then have "Le (-d) < Lt b'" "Le d < Lt a'" unfolding less by auto
          with d(1) * show ?thesis
          by - (rule exI[where x = "d"], auto,
                meson d(2) dual_order.order_iff_strict less_trans neg_le_0_iff_le)
        qed
      next
        case 3 thus ?case by (auto simp: dbm_le_def less_eq)
      qed
    next
      case 5 thus ?case
      proof (cases b, auto, goal_cases)
        case (1 b')
        from this(2) have "-b'  0"
        by (metis dbm_lt.intros(3) leI less less_asym neg_less_0_iff_less) 
        let ?d = "- b'"
        have "Le ?d  " "Le (- ?d)  Le b'" by (auto simp: any_le_inf)
        with -b'  0 show ?case by auto
      next
        case (2 b')
        then have "b'  0" by (auto elim: dbm_lt.cases simp: less)
        from non_trivial_neg obtain e :: 'a where e:"e < 0" by blast
        let ?d = "- (b' + e)"
        from e b'  0 have "Le ?d  " "Le (- ?d)  Lt b'" "b' + e < 0"
        by (auto simp: dbm_lt.intros(4) less less_imp_le any_le_inf add_nonpos_neg)
        then have "Le ?d  " "Le (- ?d)  Lt b'" "?d  0"
        using less_imp_le neg_0_le_iff_le by blast+
        thus ?case by auto
      qed
    qed
  qed
qed

lemma sum_gt_neutral_dest:
  "(a :: (('a :: time) DBMEntry)) + b > 𝟭   d. Le d  a  Le (-d)  b"
proof -
  assume A: "a + b > 𝟭"
  then have A': "b + a > 𝟭" by (simp add: comm)
  show ?thesis
  proof (cases "a  𝟭")
    case True
    with A sum_gt_neutral_dest' show ?thesis by auto
  next
    case False
    { assume "b  𝟭"
      with False have "a  𝟭" "b  𝟭" by auto
      from add_mono[OF this] have "a + b  𝟭" by auto
      with A have False by auto
    }
    then have "b  𝟭" by fastforce
    with sum_gt_neutral_dest'[OF this A'] show ?thesis by auto
  qed
qed

subsection ‹
  Negative Cycles in DBMs
›

lemma DBM_val_bounded_neg_cycle1:
fixes i xs assumes
  bounded: "DBM_val_bounded v u M n" and A:"i  n" "set xs  {0..n}" "len M i i xs < 𝟭" and
  surj_on: " k  n. k > 0  ( c. v c = k)" and at_most: "i  0" "cnt 0 xs  1"
shows False
proof -
  from A(1) surj_on at_most obtain c where c: "v c = i" by auto
  with DBM_val_bounded_len'3[OF bounded at_most(2), of c c] A(1,2) surj_on 
  have bounded:"dbm_entry_val u (Some c) (Some c) (len M i i xs)" by force
  from A(3) have "len M i i xs  Le 0" by (simp add: neutral less)
  then show False using bounded by (cases rule: dbm_lt.cases) (auto elim: dbm_entry_val.cases)
qed

lemma cnt_0_I:
  "x  set xs  cnt x xs = 0"
by (induction xs) auto

lemma distinct_cnt: "distinct xs  cnt x xs  1"
 apply (induction xs)
  apply simp
  apply (rename_tac a xs)
 apply (case_tac "x = a")
using cnt_0_I by fastforce+

lemma DBM_val_bounded_neg_cycle:
fixes i xs assumes
  bounded: "DBM_val_bounded v u M n" and A:"i  n" "set xs  {0..n}" "len M i i xs < 𝟭" and
  surj_on: " k  n. k > 0  ( c. v c = k)"
shows False
proof -
  from negative_len_shortest[OF _ A(3)] obtain j ys where ys:
    "distinct (j # ys)" "len M j j ys < 𝟭" "j  set (i # xs)" "set ys  set xs"
  by blast
  show False
  proof (cases "ys = []")
    case True
    show ?thesis
    proof (cases "j = 0")
      case True
      with ys = [] ys bounded show False unfolding DBM_val_bounded_def neutral less_eq[symmetric]
      by auto
    next
      case False
      with ys = [] DBM_val_bounded_neg_cycle1[OF bounded _ _ ys(2) surj_on] ys(3) A(1,2)
      show False by auto
    qed
  next
    case False
    from distinct_arcs_ex[OF _ _ this, of j 0 j] ys(1) obtain a b where arc:
      "a  0" "(a, b)  set (arcs j j ys)"
    by auto
    from cycle_rotate_2'[OF False this(2)] obtain zs where zs:
      "len M j j ys = len M a a (b # zs)" "set (a # b # zs) = set (j # ys)"
      "1 + length zs = length ys" "set (arcs j j ys) = set (arcs a a (b # zs))"
    by blast
    with distinct_card[OF ys(1)] have "distinct (a # b # zs)" by (intro card_distinct) auto
    with distinct_cnt[of "b # zs"] have *: "cnt 0 (b # zs)  1" by fastforce
    show ?thesis
     apply (rule DBM_val_bounded_neg_cycle1[OF bounded _ _ _ surj_on a  0 *]) 
       using zs(2) ys(3,4) A(1,2) apply fastforce+
    using zs(1) ys(2) by simp
  qed
qed

subsection ‹Floyd-Warshall Algorithm Preservers Zones›

lemma D_dest: "x = D m i j k 
  x  {len m i j xs |xs. set xs  {0..k}  i  set xs  j  set xs  distinct xs}"
using Min_elem_dest[OF D_base_finite'' D_base_not_empty] by (fastforce simp add: D_def)

lemma FW_zone_equiv:
  " k  n. k > 0  ( c. v c = k)  [M]v,n = [FW M n]v,n"
proof safe
  fix u assume A: "u  [FW M n]v,n"
  { fix i j assume "i  n" "j  n"
    hence "FW M n i j  M i j" using fw_mono[of n n n i j M n] by simp
    hence "FW M n i j  M i j" by (simp add: less_eq)
  }
  with DBM_le_subset[of n "FW M n" M] A show "u  [M]v,n" by auto
next
  fix u assume u:"u  [M]v,n" and surj_on: " k  n. k > 0  ( c. v c = k)"
  hence *:"DBM_val_bounded v u M n" by (simp add: DBM_zone_repr_def)
  note ** = DBM_val_bounded_neg_cycle[OF this _ _ _ surj_on]
  have cyc_free: "cyc_free M n" using ** by fastforce
  with cycle_free_diag_equiv have cycle_free: "cycle_free M n" by auto
  from cycle_free_diag[OF this] have diag_ge_zero: "kn. M k k  Le 0" unfolding neutral by auto
  
  have "DBM_val_bounded v u (FW M n) n" unfolding DBM_val_bounded_def
  proof (auto, goal_cases)
    case 1
    from fw_shortest_path[OF cycle_free, of 0 n 0 n n] have **:
      "D M 0 0 n = FW M n 0 0"
    by (simp add: neutral)
    from D_dest[OF **[symmetric]] obtain xs where xs:
        "FW M n 0 0 = len M 0 0 xs" "set xs  {0..n}"
        "0  set xs" "distinct xs"
    by auto
    with cyc_free have "FW M n 0 0  𝟭" by auto
    then show ?case unfolding neutral less_eq by simp
  next
    case (2 c)
    with fw_shortest_path[OF cycle_free, of 0 n "v c" n n] have **:
      "D M 0 (v c) n = FW M n 0 (v c)"
    by (simp add: neutral)
    from D_dest[OF **[symmetric]] obtain xs where xs:
        "FW M n 0 (v c) = len M 0 (v c) xs" "set xs  {0..n}"
        "0  set xs" "v c  set xs" "distinct xs"
    by auto
    show ?case unfolding xs(1) using xs surj_on v c  n
    by - (rule DBM_val_bounded_len'2[OF * xs(3)]; auto)
  next
    case (3 c)
    with fw_shortest_path[OF cycle_free, of "v c" n 0 n n] have **:
      "D M (v c) 0 n = FW M n (v c) 0"
    by (simp add: neutral)
    with D_dest[OF **[symmetric]] obtain xs where xs:
      "FW M n (v c) 0 = len M (v c) 0 xs" "set xs  {0..n}"
      "0  set xs" "v c  set xs" "distinct xs"
    by auto
    show ?case unfolding xs(1) using xs surj_on v c  n
    by - (rule DBM_val_bounded_len'1[OF * xs(3)]; auto)
  next
    case (4 c1 c2)
    with fw_shortest_path[OF cycle_free, of "v c1" n "v c2" n n]
    have "D M (v c1) (v c2) n = FW M n (v c1) (v c2)" by (simp add: neutral)
    from D_dest[OF this[symmetric]] obtain xs where xs:
      "FW M n (v c1) (v c2) = len M (v c1) (v c2) xs" "set xs  {0..n}"
      "v c1  set xs" "v c2  set xs" "distinct xs"
    by auto
    show ?case
    unfolding xs(1)
     apply (rule DBM_val_bounded_len'3[OF *])
        using xs surj_on v c1  n v c2  n apply auto
     apply (drule distinct_cnt[of _ 0])
    by auto
  qed
  then show "u  [FW M n]v,n" unfolding DBM_zone_repr_def by simp
qed

lemma new_negative_cycle_aux':
  fixes M :: "('a :: time) DBM"
  fixes i j d
  defines "M'  λ i' j'. if (i' = i  j' = j) then Le d
                       else if (i' = j  j' = i) then Le (-d)
                       else M i' j'"
  assumes "i  n" "j  n" "set xs  {0..n}" "cycle_free M n" "length xs = m"
  assumes "len M' i i (j # xs) < 𝟭  len M' j j (i # xs) < 𝟭"
  assumes "i  j"
  shows "xs. set xs  {0..n}  j  set xs  i  set xs
               (len M' i i (j # xs) < 𝟭  len M' j j (i # xs) < 𝟭)" using assms
proof (induction _ m arbitrary: xs rule: less_induct)
  case (less x)
  { fix b a xs assume A: "(i, j)  set (arcs b a xs)" "(j, i)  set (arcs b a xs)"
    with i  j have "len M' b a xs = len M b a xs"
    unfolding M'_def by (induction xs arbitrary: b) auto
  } note * = this
  { fix a xs assume A:"(i, j)  set (arcs a a xs)" "(j, i)  set (arcs a a xs)"
    assume a: "a  n" and xs: "set xs  {0..n}" and cycle: "¬ len M' a a xs  𝟭"
    from *[OF A] have "len M' a a xs = len M a a xs" .
    with ‹cycle_free M n i  n cycle xs a have False unfolding cycle_free_def by auto
  } note ** = this
  { fix a :: nat fix ys :: "nat list"
    assume A: "ys  []" "length ys  length xs" "set ys  set xs" "a  n"
    assume cycle: "len M' a a ys < 𝟭"
    assume arcs: "(i, j)  set (arcs a a ys)  (j, i)  set (arcs a a ys)"
    from arcs have ?thesis
    proof
      assume "(i, j)  set (arcs a a ys)"
      from cycle_rotate_2[OF ys  [] this, of M']
      obtain ws where ws: "len M' a a ys = len M' i i (j # ws)" "set ws  set (a # ys)"
        "length ws < length ys" by auto
      with cycle less.hyps(1)[OF _ less.hyps(2) , of "length ws" ws] less.prems A
      show ?thesis by fastforce
    next
      assume "(j, i)  set (arcs a a ys)"
      from cycle_rotate_2[OF ys  [] this, of M']
      obtain ws where ws: "len M' a a ys = len M' j j (i # ws)" "set ws  set (a # ys)"
        "length ws < length ys" by auto
      with cycle less.hyps(1)[OF _ less.hyps(2) , of "length ws" ws] less.prems A
      show ?thesis by fastforce
    qed
  } note *** = this
  { fix a :: nat fix ys :: "nat list"
    assume A: "ys  []" "length ys  length xs" "set ys  set xs" "a  n"
    assume cycle: "¬ len M' a a ys  𝟭"
    with A **[of a ys] less.prems
    have "(i, j)  set (arcs a a ys)  (j, i)  set (arcs a a ys)" by auto
    with ***[OF A] cycle have ?thesis by auto
  } note neg_cycle_IH = this
  from cycle_free_diag[OF ‹cycle_free M n] have "i. i  n  Le 0  M i i" unfolding neutral by auto
  then have M'_diag: "i. i  n  Le 0  M' i i" unfolding M'_def using i  j by auto
  from less(8) show ?thesis
  proof standard
    assume cycle:"len M' i i (j # xs) < 𝟭"
    show ?thesis
    proof (cases "i  set xs")
      case False
      then show ?thesis
      proof (cases "j  set xs")
        case False
        with i  set xs show ?thesis using less.prems(3,6) by auto
      next
        case True
        then obtain ys zs where ys_zs: "xs = ys @ j # zs" by (meson split_list)
        with len_decomp[of "j # xs" "j # ys" j zs M' i i]
        have len: "len M' i i (j # xs) = M' i j + len M' j j ys + len M' j i zs" by auto
        show ?thesis
        proof (cases "len M' j j ys  𝟭")
          case True
          have "len M' i i (j # zs) = M' i j + len M' j i zs" by simp
          also from len True have "M' i j + len M' j i zs  len M' i i (j # xs)"
          by (metis add_le_impl add_lt_neutral comm not_le)
          finally have cycle': "len M' i i (j # zs) < 𝟭" using cycle by auto
          from ys_zs less.prems(5) have "x > length zs" by auto
          from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of zs]
          show ?thesis by auto
        next
          case False
          with M'_diag less.prems have "ys  []" by (auto simp: neutral)
          from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
        qed
      qed
    next
      case True
      then obtain ys zs where ys_zs: "xs = ys @ i # zs" by (meson split_list)
      with len_decomp[of "j # xs" "j # ys" i zs M' i i]
      have len: "len M' i i (j # xs) = M' i j + len M' j i ys + len M' i i zs" by auto
      show ?thesis
      proof (cases "len M' i i zs  𝟭")
        case True
        have "len M' i i (j # ys) = M' i j + len M' j i ys" by simp
        also from len True have "M' i j + len M' j i ys  len M' i i (j # xs)"
        by (metis add_lt_neutral comm not_le)
        finally have cycle': "len M' i i (j # ys) < 𝟭" using cycle by auto
        from ys_zs less.prems(5) have "x > length ys" by auto
        from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of ys]
        show ?thesis by auto
      next
        case False
        with less.prems(1,7) M'_diag have "zs  []" by (auto simp: neutral)
        from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
      qed
    qed
  next
    assume cycle:"len M' j j (i # xs) < 𝟭"
    show ?thesis
    proof (cases "j  set xs")
      case False
      then show ?thesis
      proof (cases "i  set xs")
        case False
        with j  set xs show ?thesis using less.prems(3,6) by auto
      next
        case True
        then obtain ys zs where ys_zs: "xs = ys @ i # zs" by (meson split_list)
        with len_decomp[of "i # xs" "i # ys" i zs M' j j]
        have len: "len M' j j (i # xs) = M' j i + len M' i i ys + len M' i j zs" by auto
        show ?thesis
        proof (cases "len M' i i ys  𝟭")
          case True
          have "len M' j j (i # zs) = M' j i + len M' i j zs" by simp
          also from len True have "M' j i + len M' i j zs  len M' j j (i # xs)"
          by (metis add_le_impl add_lt_neutral comm not_le)
          finally have cycle': "len M' j j (i # zs) < 𝟭" using cycle by auto
          from ys_zs less.prems(5) have "x > length zs" by auto
          from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of zs]
          show ?thesis by auto
        next
          case False
          with less.prems M'_diag have "ys  []" by (auto simp: neutral)
          from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
        qed
      qed
    next
      case True
      then obtain ys zs where ys_zs: "xs = ys @ j # zs" by (meson split_list)
      with len_decomp[of "i # xs" "i # ys" j zs M' j j]
      have len: "len M' j j (i # xs) = M' j i + len M' i j ys + len M' j j zs" by auto
      show ?thesis
      proof (cases "len M' j j zs  𝟭")
        case True
        have "len M' j j (i # ys) = M' j i + len M' i j ys" by simp
        also from len True have "M' j i + len M' i j ys  len M' j j (i # xs)"
        by (metis add_lt_neutral comm not_le)
        finally have cycle': "len M' j j (i # ys) < 𝟭" using cycle by auto
        from ys_zs less.prems(5) have "x > length ys" by auto
        from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of ys]
        show ?thesis by auto
      next
        case False
        with less.prems(2,7) M'_diag have "zs  []" by (auto simp: neutral)
        from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
      qed
    qed
  qed
qed

lemma new_negative_cycle_aux:
  fixes M :: "('a :: time) DBM"
  fixes i d
  defines "M'  λ i' j'. if (i' = i  j' = 0) then Le d
                       else if (i' = 0  j' = i) then Le (-d)
                       else M i' j'"
  assumes "i  n" "set xs  {0..n}" "cycle_free M n" "length xs = m"
  assumes "len M' 0 0 (i # xs) < 𝟭  len M' i i (0 # xs) < 𝟭"
  assumes "i  0"
  shows "xs. set xs  {0..n}  0  set xs  i  set xs
               (len M' 0 0 (i # xs) < 𝟭  len M' i i (0 # xs) < 𝟭)" using assms
proof (induction _ m arbitrary: xs rule: less_induct)
  case (less x)
  { fix b a xs assume A: "(0, i)  set (arcs b a xs)" "(i, 0)  set (arcs b a xs)"
    then have "len M' b a xs = len M b a xs"
    unfolding M'_def by (induction xs arbitrary: b) auto
  } note * = this
  { fix a xs assume A:"(0, i)  set (arcs a a xs)" "(i, 0)  set (arcs a a xs)"
    assume a: "a  n" and xs: "set xs  {0..n}" and cycle: "¬ len M' a a xs  𝟭"
    from *[OF A] have "len M' a a xs = len M a a xs" .
    with ‹cycle_free M n i  n cycle xs a have False unfolding cycle_free_def by auto
  } note ** = this
  { fix a :: nat fix ys :: "nat list"
    assume A: "ys  []" "length ys  length xs" "set ys  set xs" "a  n"
    assume cycle: "len M' a a ys < 𝟭"
    assume arcs: "(0, i)  set (arcs a a ys)  (i, 0)  set (arcs a a ys)"
    from arcs have ?thesis
    proof
      assume "(0, i)  set (arcs a a ys)"
      from cycle_rotate_2[OF ys  [] this, of M']
      obtain ws where ws: "len M' a a ys = len M' 0 0 (i # ws)" "set ws  set (a # ys)"
        "length ws < length ys" by auto
      with cycle less.hyps(1)[OF _ less.hyps(2) , of "length ws" ws] less.prems A
      show ?thesis by fastforce
    next
      assume "(i, 0)  set (arcs a a ys)"
      from cycle_rotate_2[OF ys  [] this, of M']
      obtain ws where ws: "len M' a a ys = len M' i i (0 # ws)" "set ws  set (a # ys)"
        "length ws < length ys" by auto
      with cycle less.hyps(1)[OF _ less.hyps(2) , of "length ws" ws] less.prems A
      show ?thesis by fastforce
    qed
  } note *** = this
  { fix a :: nat fix ys :: "nat list"
    assume A: "ys  []" "length ys  length xs" "set ys  set xs" "a  n"
    assume cycle: "¬ len M' a a ys  𝟭"
    with A **[of a ys]  less.prems(2)
    have "(0, i)  set (arcs a a ys)  (i, 0)  set (arcs a a ys)" by auto
    with ***[OF A] cycle have ?thesis by auto
  } note neg_cycle_IH = this
  from cycle_free_diag[OF ‹cycle_free M n] have "i. i  n  Le 0  M i i" unfolding neutral by auto
  then have M'_diag: "i. i  n  Le 0  M' i i" unfolding M'_def using i  0 by auto
  from less(7) show ?thesis
  proof standard
    assume cycle:"len M' 0 0 (i # xs) < 𝟭"
    show ?thesis
    proof (cases "0  set xs")
      case False
      thus ?thesis
      proof (cases "i  set xs")
        case False
        with 0  set xs show ?thesis using less.prems by auto
      next
        case True
        then obtain ys zs where ys_zs: "xs = ys @ i # zs" by (meson split_list)
        with len_decomp[of "i # xs" "i # ys" i zs M' 0 0]
        have len: "len M' 0 0 (i # xs) = M' 0 i + len M' i i ys + len M' i 0 zs" by auto
        show ?thesis
        proof (cases "len M' i i ys  𝟭")
          case True
          have "len M' 0 0 (i # zs) = M' 0 i + len M' i 0 zs" by simp
          also from len True have "M' 0 i + len M' i 0 zs  len M' 0 0 (i # xs)"
          by (metis add_le_impl add_lt_neutral comm not_le)
          finally have cycle': "len M' 0 0 (i # zs) < 𝟭" using cycle by auto
          from ys_zs less.prems(4) have "x > length zs" by auto
          from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of zs]
          show ?thesis by auto
        next
          case False
          with less.prems(1,6) M'_diag have "ys  []" by (auto simp: neutral)
          from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
        qed
      qed
    next
      case True
      then obtain ys zs where ys_zs: "xs = ys @ 0 # zs" by (meson split_list)
      with len_decomp[of "i # xs" "i # ys" 0 zs M' 0 0]
      have len: "len M' 0 0 (i # xs) = M' 0 i + len M' i 0 ys + len M' 0 0 zs" by auto
      show ?thesis
      proof (cases "len M' 0 0 zs  𝟭")
        case True
        have "len M' 0 0 (i # ys) = M' 0 i + len M' i 0 ys" by simp
        also from len True have "M' 0 i + len M' i 0 ys  len M' 0 0 (i # xs)"
        by (metis add_lt_neutral comm not_le)
        finally have cycle': "len M' 0 0 (i # ys) < 𝟭" using cycle by auto
        from ys_zs less.prems(4) have "x > length ys" by auto
        from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of ys]
        show ?thesis by auto
      next
        case False
        with less.prems(1,6) M'_diag have "zs  []" by (auto simp: neutral)
        from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
      qed
    qed
  next
    assume cycle: "len M' i i (0 # xs) < 𝟭"
    show ?thesis
    proof (cases "i  set xs")
      case False
      thus ?thesis
      proof (cases "0  set xs")
        case False
        with i  set xs show ?thesis using less.prems by auto
      next
        case True
        then obtain ys zs where ys_zs: "xs = ys @ 0 # zs" by (meson split_list)
        with len_decomp[of "0 # xs" "0 # ys" 0 zs M' i i]
        have len: "len M' i i (0 # xs) = M' i 0 + len M' 0 0 ys + len M' 0 i zs" by auto
        show ?thesis
        proof (cases "len M' 0 0 ys  𝟭")
          case True
          have "len M' i i (0 # zs) = M' i 0 + len M' 0 i zs" by simp
          also from len True have "M' i 0 + len M' 0 i zs  len M' i i (0 # xs)"
          by (metis add_le_impl add_lt_neutral comm not_le)
          finally have cycle': "len M' i i (0 # zs) < 𝟭" using cycle by auto
          from ys_zs less.prems(4) have "x > length zs" by auto
          from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of zs]
          show ?thesis by auto
        next
          case False
          with less.prems(1,6) M'_diag have "ys  []" by (auto simp: neutral)
          from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
        qed
      qed
    next
      case True
      then obtain ys zs where ys_zs: "xs = ys @ i # zs" by (meson split_list)
      with len_decomp[of "0 # xs" "0 # ys" i zs M' i i]
      have len: "len M' i i (0 # xs) = M' i 0 + len M' 0 i ys + len M' i i zs" by auto
      show ?thesis
      proof (cases "len M' i i zs  𝟭")
        case True
        have "len M' i i (0 # ys) = M' i 0 + len M' 0 i ys" by simp
        also from len True have "M' i 0 + len M' 0 i ys  len M' i i (0 # xs)"
        by (metis add_lt_neutral comm not_le)
        finally have cycle': "len M' i i (0 # ys) < 𝟭" using cycle by auto
        from ys_zs less.prems(4) have "x > length ys" by auto
        from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of ys]
        show ?thesis by auto
      next
        case False
        with less.prems(1,6) M'_diag have "zs  []" by (auto simp: neutral)
        from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
      qed
    qed
  qed
qed


section ‹The Characteristic Property of Canonical DBMs›

theorem fix_index':
  fixes M :: "(('a :: time) DBMEntry) mat"
  assumes "Le r  M i j" "Le (-r)  M j i" "cycle_free M n" "canonical M n" "i  n" "j  n" "i  j"
  defines "M'  λ i' j'. if (i' = i  j' = j) then Le r
                       else if (i' = j  j' = i) then Le (-r)
                       else M i' j'"
  shows "( u. DBM_val_bounded v u M' n  DBM_val_bounded v u M n)  cycle_free M' n"
proof -
  note A = assms
  note r = assms(1,2)
  from ‹cycle_free M n have diag_cycles: "i xs. i  n  set xs  {0..n}  Le 0  len M i i xs"
  unfolding cycle_free_def neutral by auto
  let ?M' = "λ i' j'. if (i' = i  j' = j) then Le r
                       else if (i' = j  j' = i) then Le (-r)
                       else M i' j'"
  have "?M' i' j'  M i' j'" when "i'  n" "j'  n" for i' j' using assms by auto
  with DBM_le_subset[folded less_eq, of n ?M' M] have "DBM_val_bounded v u M n"
  if "DBM_val_bounded v u ?M' n" for u unfolding DBM_zone_repr_def using that by auto
  then have not_empty:" u. DBM_val_bounded v u ?M' n  DBM_val_bounded v u M n" by auto
  { fix a xs assume prems: "a  n" "set xs  {0..n}" and cycle: "¬ len ?M' a a xs  𝟭"
    { fix b assume A: "(i, j)  set (arcs b a xs)" "(j, i)  set (arcs b a xs)"
      with i  j have "len ?M' b a xs = len M b a xs" by (induction xs arbitrary: b) auto
    } note * = this
    { fix a b xs assume A: "i  set (a # xs)" "j  set (a # xs)"
      then have "len ?M' a b xs = len M a b xs" by (induction xs arbitrary: a, auto)
    } note ** = this
    { assume A:"(i, j)  set (arcs a a xs)" "(j, i)  set (arcs a a xs)"
      from *[OF this] have "len ?M' a a xs = len M a a xs" .
      with ‹cycle_free M n prems cycle have False by (auto simp: cycle_free_def)
    }
    then have arcs:"(i, j)  set (arcs a a xs)  (j, i)  set (arcs a a xs)" by auto
    with i  j have "xs  []" by auto
    from arcs obtain xs where xs: "set xs  {0..n}"
      "len ?M' i i (j # xs) < 𝟭  len ?M' j j (i # xs) < 𝟭"
    proof (standard, goal_cases)
      case 1
      from cycle_rotate_2'[OF xs  [] this(2), of ?M'] prems obtain ys where
        "len ?M' i i (j # ys) = len ?M' a a xs" "set ys  {0..n}"
      by fastforce
      with 1 cycle show ?thesis by fastforce
    next
      case 2
      from cycle_rotate_2'[OF xs  [] this(2), of ?M'] prems obtain ys where
        "len ?M' j j (i # ys) = len ?M' a a xs" "set ys  {0..n}"
      by fastforce
      with 2 cycle show ?thesis by fastforce
    qed
    from new_negative_cycle_aux'[OF i  n j  n this(1) ‹cycle_free M n _ this(2) i  j]
    obtain xs where xs:
      "set xs  {0..n}" "i  set xs" "j  set xs"
      "len ?M' i i (j # xs) < 𝟭  len ?M' j j (i # xs) < 𝟭"
    by auto
    from this(4) have False
    proof
      assume A: "len ?M' j j (i # xs) < 𝟭"
      show False
      proof (cases xs)
        case Nil
        with i  j have *:"?M' j i = Le (-r)" "?M' i j = Le r" by simp+
        from Nil have "len ?M' j j (i # xs) = ?M' j i + ?M' i j" by simp
        with * have "len ?M' j j (i # xs) = Le 0" by (simp add: mult)
        then show False using A by (simp add: neutral)
      next
        case (Cons y ys)
        have *:"M i y + M y j  M i j"
        using ‹canonical M n Cons xs i  n j  n by (simp add: mult less_eq)
        have "Le 0 = Le (-r) + Le r" by (simp add: mult)
        also have "  Le (-r) + M i j" using r by (simp add: add_mono)
        also have "  Le (-r) + M i y + M y j" using * by (simp add: add_mono assoc)
        also have "  Le (-r) + ?M' i y + len M y j ys"
        using canonical_len[OF ‹canonical M n] xs(1-3) i  n j  n Cons by (simp add: add_mono)
        also have " = len ?M' j j (i # xs)" using Cons i  j ** xs(1-3) by (simp add: assoc)
        also have " < Le 0" using A by (simp add: neutral)
        finally show False by simp
      qed
    next
      assume A: "len ?M' i i (j # xs) < 𝟭"
      show False
      proof (cases xs)
        case Nil
        with i  j have *:"?M' j i = Le (-r)" "?M' i j = Le r" by simp+
        from Nil have "len ?M' i i (j # xs) = ?M' i j + ?M' j i" by simp
        with * have "len ?M' i i (j # xs) = Le 0" by (simp add: mult)
        then show False using A by (simp add: neutral)
      next
        case (Cons y ys)
        have *:"M j y + M y i  M j i"
        using ‹canonical M n Cons xs i  n j  n by (simp add: mult less_eq)
        have "Le 0 = Le r + Le (-r)" by (simp add: mult)
        also have "  Le r + M j i" using r by (simp add: add_mono)
        also have "  Le r + M j y + M y i" using * by (simp add: add_mono assoc)
        also have "  Le r + ?M' j y + len M y i ys"
        using canonical_len[OF ‹canonical M n] xs(1-3) i  n j  n Cons by (simp add: add_mono)
        also have " = len ?M' i i (j # xs)" using Cons i  j ** xs(1-3) by (simp add: assoc)
        also have " < Le 0" using A by (simp add: neutral)
        finally show False by simp
      qed
    qed
  } note * = this
  have "cycle_free ?M' n" using negative_cycle_dest_diag * by fastforce
  then show ?thesis using not_empty i  j r unfolding M'_def by auto
qed

lemma fix_index:
  fixes M :: "(('a :: time) DBMEntry) mat"
  assumes "M 0 i + M i 0 > 𝟭" "cycle_free M n" "canonical M n" "i  n" "i  0"
  shows
  " (M' :: ('a DBMEntry) mat). (( u. DBM_val_bounded v u M' n)  ( u. DBM_val_bounded v u M n))
      M' 0 i + M' i 0 = 𝟭  cycle_free M' n
      ( j. i  j  M 0 j + M j 0 = 𝟭  M' 0 j + M' j 0 = 𝟭)
      ( j. i  j  M 0 j + M j 0 > 𝟭  M' 0 j + M' j 0 > 𝟭)"
proof -
  note A = assms
  from sum_gt_neutral_dest[OF assms(1)] obtain d where d: "Le d  M i 0" "Le (-d)  M 0 i" by auto
  have "i  0" using A by - (rule ccontr; simp)
  let ?M' = "λi' j'. if i' = i  j' = 0 then Le d else if i' = 0  j' = i then Le (-d) else M i' j'"
  from fix_index'[OF d(1,2) A(2,3,4) _ i  0] have M':
    "u. DBM_val_bounded v u ?M' n  DBM_val_bounded v u M n" "cycle_free ?M' n"
  by auto
  moreover from i  0 have " j. i  j  M 0 j + M j 0 = 𝟭  ?M' 0 j + ?M' j 0 = 𝟭" by auto
  moreover from i  0 have " j. i  j  M 0 j + M j 0 > 𝟭  ?M' 0 j + ?M' j 0 > 𝟭" by auto
  moreover from i  0 have "?M' 0 i + ?M' i 0 = 𝟭" unfolding neutral mult by auto
  ultimately show ?thesis by blast
qed

subsubsection ‹
  Putting it together
›

lemma FW_not_empty:
  "DBM_val_bounded v u (FW M' n) n  DBM_val_bounded v u M' n"
proof -
  assume A: "DBM_val_bounded v u (FW M' n) n"
  have "i j. i  n  j  n  FW M' n i j  M' i j" using fw_mono by blast
  from DBM_le_subset[of n "FW M' n" M' _ v, OF this[unfolded less_eq]]
  show "DBM_val_bounded v u M' n" using A by (auto simp: DBM_zone_repr_def)
qed

lemma fix_indices:
  fixes M :: "(('a :: time) DBMEntry) mat"
  assumes "set xs  {0..n}" "distinct xs"
  assumes "cyc_free M n" "canonical M n"
  shows 
  " (M' :: ('a DBMEntry) mat). (( u. DBM_val_bounded v u M' n)  ( u. DBM_val_bounded v u M n))
      ( i  set xs. i  0  M' 0 i + M' i 0 = 𝟭)  cyc_free M' n
      ( in. i  set xs  M 0 i + M i 0 = 𝟭  M' 0 i + M' i 0 = 𝟭)" using assms
proof (induction xs arbitrary: M)
  case Nil then show ?case by auto
next
  case (Cons i xs)
  show ?case
  proof (cases "M 0 i + M i 0  𝟭  i = 0")
    case True
    note T = this
    show ?thesis
    proof (cases "i = 0")
      case False
      from Cons.prems have "0  n" "set [i]  {0..n}" by auto
      with Cons.prems(3) False T have "M 0 i + M i 0 = 𝟭" by fastforce
      with Cons.IH[OF _ _ Cons.prems(3,4)] Cons.prems(1,2) show ?thesis by auto
    next
      case True
      with Cons.IH[OF _ _ Cons.prems(3,4)] Cons.prems(1,2) show ?thesis by auto
    qed
  next
    case False
    with Cons.prems have "𝟭 < M 0 i + M i 0" "i  n" "i  0" by auto
    with fix_index[OF this(1) cycle_free_diag_intro[OF Cons.prems(3)] Cons.prems(4) this(2,3), of v]
    obtain M' :: "('a DBMEntry) mat" where M':
      "((u. DBM_val_bounded v u M' n)  (u. DBM_val_bounded v u M n))" "(M' 0 i + M' i 0 = 𝟭)"
      "cyc_free M' n" "jn. i  j  M 0 j + M j 0 > 𝟭  M' 0 j + M' j 0 > 𝟭"
      "j. i  j  M 0 j + M j 0 = 𝟭  M' 0 j + M' j 0 = 𝟭"
    using cycle_free_diag_equiv by blast
    let ?M' = "FW M' n"
    from fw_canonical[of M' n] cycle_free_diag_equiv ‹cyc_free M' n have "canonical ?M' n" by auto
    from FW_cyc_free_preservation[OF ‹cyc_free M' n] have "cyc_free ?M' n"
    by auto
    from FW_fixed_preservation[OF i  n M'(2) ‹canonical ?M' n ‹cyc_free ?M' n]
    have fixed:"?M' 0 i + ?M' i 0 = 𝟭" by (auto simp: add_mono)
    from Cons.IH[OF _ _ ‹cyc_free ?M' n ‹canonical ?M' n] Cons.prems(1,2,3)
    obtain M'' :: "('a DBMEntry) mat"
    where M'': "((u. DBM_val_bounded v u M'' n)  (u. DBM_val_bounded v u ?M' n))"
      "(iset xs. i  0  M'' 0 i + M'' i 0 = 𝟭)" "cyc_free M'' n"
      "(in. i  set xs  ?M' 0 i + ?M' i 0 = 𝟭  M'' 0 i + M'' i 0 = 𝟭)"
    by auto
    from FW_fixed_preservation[OF _ _ ‹canonical ?M' n ‹cyc_free ?M' n] M'(5)
    have "jn. i  j  M 0 j + M j 0 = 𝟭  ?M' 0 j + ?M' j 0 = 𝟭" by auto
    with M''(4) have "jn. j  set (i # xs)  M 0 j + M j 0 = 𝟭  M'' 0 j + M'' j 0 = 𝟭" by auto
    moreover from M''(2) M''(4) fixed Cons.prems(2) i  n
    have "(iset (i#xs). i  0  M'' 0 i + M'' i 0 = 𝟭)" by auto
    moreover from M''(1) M'(1) FW_not_empty[of v _ M' n]
    have "(u. DBM_val_bounded v u M'' n)  (u. DBM_val_bounded v u M n)" by auto
    ultimately show ?thesis using ‹cyc_free M'' n M''(4) by auto
  qed
qed

lemma cyc_free_obtains_valuation:
  "cyc_free M n   c. v c  n  v c > 0   u. DBM_val_bounded v u M n"
proof -
  assume A: "cyc_free M n" " c. v c  n  v c > 0"
  let ?M = "FW M n"
  from fw_canonical[of M n] cycle_free_diag_equiv A have "canonical ?M n" by auto
  from FW_cyc_free_preservation[OF A(1) ] have "cyc_free ?M n" .
  have "set [0..<n+1]  {0..n}" "distinct [0..<n+1]" by auto
  from fix_indices[OF this ‹cyc_free ?M n ‹canonical ?M n]
  obtain M' :: "('a DBMEntry) mat" where M':
    "(u. DBM_val_bounded v u M' n)  (u. DBM_val_bounded v u (FW M n) n)"
    "iset [0..<n + 1]. i  0  M' 0 i + M' i 0 = 𝟭" "cyc_free M' n"
  by blast
  let ?M' = "FW M' n"
  have " i. i  n  i  set [0..<n + 1]" by auto
  with M'(2) have M'_fixed: "in. i  0  M' 0 i + M' i 0 = 𝟭" by fastforce
  from fw_canonical[of M' n] cycle_free_diag_equiv M'(3) have "canonical ?M' n" by blast
  from FW_fixed_preservation[OF _ _ this FW_cyc_free_preservation[OF M'(3)]] M'_fixed
  have fixed: "in. i  0  ?M' 0 i + ?M' i 0 = 𝟭" by auto
  have *: "i. i  n  i  0   d. ?M' 0 i = Le (-d)  ?M' i 0 = Le d"
  proof -
    fix i assume i: "i  n" "i  0"
    from i fixed have *:"dbm_add (?M' 0 i) (?M' i 0) = Le 0" by (auto simp add: mult neutral)
    moreover
    { fix a b :: 'a assume "a + b = 0"
      then have "a = -b" by (simp add: eq_neg_iff_add_eq_0) 
    }
    ultimately show "d. ?M' 0 i = Le (-d)  ?M' i 0 = Le d"
    by (cases "?M' 0 i"; cases "?M' i 0"; simp)
  qed
  then obtain f where f: " in. i  0  Le (f i) = ?M' i 0  Le (- f i) = ?M' 0 i" by metis
  let ?u = "λ c. f (v c)"
  have "DBM_val_bounded v ?u ?M' n"
  proof (auto simp add: DBM_val_bounded_def, goal_cases)
    case 1
    from cyc_free_diag_dest'[OF FW_cyc_free_preservation[OF M'(3)]] show ?case
    unfolding neutral less_eq by fast
  next
    case (2 c)
    with A(2) have **: "v c > 0" by auto
    with *[OF 2] obtain d where d: "Le (-d) = ?M' 0 (v c)" by auto
    with f 2 ** have "Le (- f (v c)) = Le (- d)" by simp
    then have "- f (v c)  - d" by auto
    from dbm_entry_val.intros(2)[of ?u , OF this] d
    show ?case by auto
  next
    case (3 c)
    with A(2) have **: "v c > 0" by auto
    with *[OF 3] obtain d where d: "Le d = ?M' (v c) 0" by auto
    with f 3 ** have "Le (f (v c)) = Le d" by simp
    then have "f (v c)  d" by auto
    from dbm_entry_val.intros(1)[of ?u, OF this] d
    show ?case by auto
  next
    case (4 c1 c2)
    with A(2) have **: "v c1 > 0" "v c2 > 0" by auto
    with *[OF 4(1)] obtain d1 where d1: "Le d1 = ?M' (v c1) 0" by auto
    with f 4 ** have "Le (f (v c1)) = Le d1" by simp
    then have d1': "f (v c1) = d1" by auto
    from *[OF 4(2)] ** obtain d2 where d2: "Le d2 = ?M' (v c2) 0" by auto
    with f 4 ** have "Le (f (v c2)) = Le d2" by simp
    then have d2': "f (v c2) = d2" by auto
    have "Le d1  ?M' (v c1) (v c2) + Le d2" using ‹canonical ?M' n 4 d1 d2
    by (auto simp add: less_eq mult)
    then show ?case
    proof (cases "?M' (v c1) (v c2)", auto, goal_cases)
      case (1 d)
      from this(1) have "d1  d + d2" by (auto simp: mult less_eq le_dbm_le)
      then have "d1 - d2  d" by (simp add: diff_le_eq) 
      then show ?case using d1' d2' by auto
    next
      case (2 d)
      from this(1) have "d1 < d + d2" by (auto simp: mult less_eq dbm_le_def elim: dbm_lt.cases)
      then have "d1 - d2 < d" using diff_less_eq by blast 
      then show ?case using d1' d2' by auto
    qed
  qed
  from M'(1) FW_not_empty[OF this] obtain u where "DBM_val_bounded v u ?M n" by auto
  from FW_not_empty[OF this] show ?thesis by auto
qed

subsection ‹Floyd-Warshall and Empty DBMs›

theorem FW_detects_empty_zone:
  "kn. 0 < k  (c. v c = k)   c. v c  n  v c > 0
   [FW M n]v,n = {}  ( in. (FW M n) i i < Le 0)"
proof
  assume surj_on:"kn. 0 < k  (c. v c = k)" and "in. (FW M n) i i < Le 0"
  then obtain i where *: "len (FW M n) i i [] < 𝟭" "i n" by (auto simp add: neutral)
  show "[FW M n]v,n = {}"
  proof (rule ccontr, goal_cases)
    case 1
    then obtain u where "DBM_val_bounded v u (FW M n) n" unfolding DBM_zone_repr_def by auto
    from DBM_val_bounded_neg_cycle[OF this *(2) _ *(1) surj_on] show ?case by auto
  qed
next
  assume surj_on: "kn. 0 < k  (c. v c = k)" and empty: "[FW M n]v,n = {}"
  and    cn: " c. v c  n  v c > 0"
  show " in. (FW M n) i i < Le 0"
  proof (rule ccontr, goal_cases)
    case 1
    then have *:"in. FW M n i i  𝟭" by (auto simp add: neutral)
    have "cyc_free M n"
    proof (rule ccontr)
      assume "¬ cyc_free M n"
      then have A: "¬ cycle_free M n" using cycle_free_diag_equiv by auto
      from FW_neg_cycle_detect[OF A] * show False by auto
    qed
    from FW_cyc_free_preservation[OF this] have "cyc_free (FW M n) n" .
    from cyc_free_obtains_valuation[OF ‹cyc_free (FW M n) n cn] empty
    obtain u where "DBM_val_bounded v u (FW M n) n" by blast
    with empty show ?case by (auto simp add: DBM_zone_repr_def)
  qed
qed

(* This definition is "internal" to the theorems for the correctness of the Floyd-Warshall algorithm
   and we want to reuse this as a variable name, so we hide it away *)
hide_const D

subsection ‹Mixed Corollaries›

lemma cyc_free_not_empty:
  assumes "cyc_free M n" "c. v c  n  0 < v c"
  shows "[(M :: ('a :: time) DBM)]v,n  {}"
using cyc_free_obtains_valuation[OF assms(1,2)] unfolding DBM_zone_repr_def by auto

lemma empty_not_cyc_free:
  assumes "c. v c  n  0 < v c" "[(M :: ('a :: time) DBM)]v,n = {}"
  shows "¬ cyc_free M n"
using assms by (meson cyc_free_not_empty)

lemma not_empty_cyc_free:
  assumes "kn. 0 < k  ( c. v c = k)" "[(M :: ('a :: time) DBM)]v,n  {}"
  shows "cyc_free M n" using DBM_val_bounded_neg_cycle[OF _ _ _ _ assms(1)] assms(2)
unfolding DBM_zone_repr_def by fastforce

lemma neg_cycle_empty:
  assumes "kn. 0 < k  ( c. v c = k)" "set xs  {0..n}" "i  n" "len M i i xs < 𝟭"
  shows "[(M :: ('a :: time) DBM)]v,n = {}" using assms
by (metis leD not_empty_cyc_free)

abbreviation clock_numbering' :: "('c  nat)  nat  bool"
where
  "clock_numbering' v n   c. v c > 0  (x. y. v x  n  v y  n  v x = v y  x = y)"

lemma non_empty_dbm_diag_set:
  "clock_numbering' v n  [M]v,n  {}  [M]v,n = [(λ i j. if i = j then 𝟭 else M i j)]v,n"
proof (auto simp: DBM_zone_repr_def, goal_cases)
  case 1
  { fix c assume A: "v c = 0"
    from 1 have "v c > 0" by auto
    with A have False by auto
  } note * = this
  from 1(1) have [simp]: "Le 0  M 0 0" by (auto simp: DBM_val_bounded_def)
  from 1 show ?case
    apply (auto simp add: DBM_val_bounded_def neutral)
         using * apply meson+
    apply (rename_tac c1 c2)
    apply (case_tac "c1 = c2")
     apply auto
  done
next
  case (2 x xa)
  note G = this
  { fix c assume A: "v c = 0"
    from 2 have "v c > 0" by auto
    with A have False by auto
  } note * = this
  { fix c assume A: "v c  n" "M (v c) (v c) < 𝟭"
    with 2(1) have False
      apply (auto simp: neutral DBM_val_bounded_def less)
      apply (cases rule: dbm_lt.cases)
    by fastforce+
  } note ** = this
  from 2(1) have [simp]: "Le 0  M 0 0" by (auto simp: DBM_val_bounded_def)
  from 2 show ?case
  proof (auto simp add: DBM_val_bounded_def neutral, goal_cases)
    case 1 with * show ?case by presburger
    case 2 with * show ?case by presburger
  next
    case (3 c1 c2)
    show ?case
    proof (cases "v c1 = v c2")
      case True
      with 3 have "c1 = c2" by auto
      moreover with **[OF 3(8)] not_less have "M (v c2) (v c2)  𝟭" by auto
      ultimately show "dbm_entry_val xa (Some c1) (Some c2) (M (v c1) (v c2))" unfolding neutral
      by (cases "M (v c1) (v c2)") (auto simp add: less_eq dbm_le_def, fastforce+)
    next
      case False
      with 3 show ?thesis by presburger
    qed
  qed
qed

lemma non_empty_cycle_free:
  assumes "[M]v,n  {}"
    and "kn. 0 < k  (c. v c = k)"
  shows "cycle_free M n"
apply (rule ccontr)
apply (drule negative_cycle_dest_diag) 
using DBM_val_bounded_neg_cycle assms unfolding DBM_zone_repr_def by blast

lemma neg_diag_empty:
  assumes "kn. 0 < k  (c. v c = k)" "i  n" "M i i < 𝟭"
  shows "[M]v,n = {}"
unfolding DBM_zone_repr_def using DBM_val_bounded_neg_cycle[of v _ M n i "[]"] assms by auto

lemma canonical_empty_zone:
  assumes "kn. 0 < k  (c. v c = k)" "c. v c  n  0 < v c"
    and "canonical M n"
  shows "[M]v,n = {}  (in. M i i < 𝟭)"
using FW_detects_empty_zone[OF assms(1,2), of M] FW_canonical_id[OF assms(3)] unfolding neutral
by simp

end

Theory DBM_Operations

chapter ‹Forward Analysis on DBMs›

theory DBM_Operations
  imports DBM_Basics
begin

section ‹Auxiliary›

lemma gt_swap:
  fixes a b c :: "'t :: time"
  assumes "c < a + b"
  shows "c < b + a"
by (simp add: add.commute assms)

lemma le_swap:
  fixes a b c :: "'t :: time"
  assumes "c  a + b"
  shows "c  b + a"
by (simp add: add.commute assms)

abbreviation clock_numbering :: "('c  nat)  bool"
where
  "clock_numbering v   c. v c > 0"

section ‹Time Lapse›

definition up :: "('t::time) DBM  ('t::time) DBM"
where
  "up M 
    λ i j. if i > 0 then if j = 0 then  else min (dbm_add (M i 0) (M 0 j)) (M i j) else M i j"

lemma dbm_entry_dbm_lt:
  assumes "dbm_entry_val u (Some c1) (Some c2) a" "a  b"
  shows "dbm_entry_val u (Some c1) (Some c2) b"
using assms
proof (cases, auto, goal_cases)
  case 1 thus ?case by (cases, auto)
next
  case 2 thus ?case by (cases, auto)
qed

lemma dbm_entry_dbm_min2:
  assumes "dbm_entry_val u None (Some c) (min a b)"
  shows "dbm_entry_val u None (Some c) b"
using dbm_entry_val_mono_2[folded less_eq, OF assms] by auto

lemma dbm_entry_dbm_min3:
  assumes "dbm_entry_val u (Some c) None (min a b)"
  shows "dbm_entry_val u (Some c) None b"
using dbm_entry_val_mono_3[folded less_eq, OF assms] by auto

lemma dbm_entry_dbm_min:
  assumes "dbm_entry_val u (Some c1) (Some c2) (min a b)"
  shows "dbm_entry_val u (Some c1) (Some c2) b"
using dbm_entry_val_mono_1[folded less_eq, OF assms] by auto

lemma dbm_entry_dbm_min3':
  assumes "dbm_entry_val u (Some c) None (min a b)"
  shows "dbm_entry_val u (Some c) None a"
using dbm_entry_val_mono_3[folded less_eq, OF assms] by auto

lemma dbm_entry_dbm_min2':
  assumes "dbm_entry_val u None (Some c) (min a b)"
  shows "dbm_entry_val u None (Some c) a"
using dbm_entry_val_mono_2[folded less_eq, OF assms] by auto

lemma dbm_entry_dbm_min':
  assumes "dbm_entry_val u (Some c1) (Some c2) (min a b)"
  shows "dbm_entry_val u (Some c1) (Some c2) a"
using dbm_entry_val_mono_1[folded less_eq, OF assms] by auto

lemma DBM_up_complete': "clock_numbering v  u  ([M]v,n)  u  [up M]v,n"
unfolding up_def DBM_zone_repr_def DBM_val_bounded_def zone_delay_def
proof (safe, goal_cases)
  case prems: (2 u d c)
  hence *: "dbm_entry_val u None (Some c) (M 0 (v c))" by auto
  thus ?case
  proof (cases, goal_cases)
    case (1 d')
    have "- (u c + d)  - u c" using d  0 by simp
    with 1(2) have "- (u c + d) d'" by (blast intro: order.trans)
    thus ?case unfolding cval_add_def using 1 by fastforce
  next
    case (2 d')
    have "- (u c + d)  - u c" using d  0 by simp
    with 2(2) have "- (u c + d) < d'" by (blast intro: order_le_less_trans)
    thus ?case unfolding cval_add_def using 2 by fastforce
  qed auto
next
  case prems: (4 u d c1 c2)
  then have
    "dbm_entry_val u (Some c1) None (M (v c1) 0)" "dbm_entry_val u None (Some c2) (M 0 (v c2))"
  by auto
  from dbm_entry_val_add_4[OF this] prems have
    "dbm_entry_val u (Some c1) (Some c2) (min (dbm_add (M (v c1) 0) (M 0 (v c2))) (M (v c1) (v c2)))"
  by (auto split: split_min)
  with prems(1) show ?case
  by (cases "min (dbm_add (M (v c1) 0) (M 0 (v c2))) (M (v c1) (v c2))", auto simp: cval_add_def)
qed auto

fun theLe :: "('t::time) DBMEntry  't" where
  "theLe (Le d) = d" |
  "theLe (Lt d) = d" |
  "theLe  = 0"

lemma DBM_up_sound':
  assumes "clock_numbering' v n" "u  [up M]v,n"
  shows "u  ([M]v,n)"
unfolding DBM_zone_repr_def zone_delay_def using assms
proof (clarsimp, goal_cases)
  case A: 1
  obtain S_Max_Le where S_Max_Le:
    "S_Max_Le = {d - u c | c d. 0 < v c  v c  n  M (v c) 0 = Le d}"
  by auto
  obtain S_Max_Lt where S_Max_Lt:
    "S_Max_Lt = {d - u c | c d. 0 < v c  v c  n  M (v c) 0 = Lt d}"
  by auto
  obtain S_Min_Le where S_Min_Le:
    "S_Min_Le = {- d - u c| c d. 0 < v c  v c  n  M 0 (v c) = Le d}"
  by auto
  obtain S_Min_Lt where S_Min_Lt:
    "S_Min_Lt = {- d - u c | c d. 0 < v c  v c  n  M 0 (v c) = Lt d}"
  by auto
  have "finite {c. 0 < v c  v c  n}"
  using A(2,3)
  proof (induction n)
    case 0
    then have "{c. 0 < v c  v c  0} = {}" by auto
    then show ?case by (metis finite.emptyI) 
  next
    case (Suc n)
    then have "finite {c. 0 < v c  v c  n}" by auto
    moreover have "{c. 0 < v c  v c  Suc n} = {c. 0 < v c  v c  n}  {c. v c = Suc n}" by auto
    moreover have "finite {c. v c = Suc n}"
    proof (cases "{c. v c = Suc n} = {}", auto)
      fix c assume "v c = Suc n"
      then have "{c. v c = Suc n} = {c}" using Suc.prems(2) by auto
      then show ?thesis by auto
    qed
    ultimately show ?case by auto
  qed
  then have " f. finite {(c,b) | c b. 0 < v c  v c  n  f M (v c) = b}" by auto
  moreover have
    " f K. {(c,K d) | c d. 0 < v c  v c  n  f M (v c) = K d}
     {(c,b) | c b. 0 < v c  v c  n  f M (v c) = b}"
  by auto
  ultimately have 1:
    " f K. finite {(c,K d) | c d. 0 < v c  v c  n  f M (v c) = K d}" using finite_subset
  by fast
  have " f K. theLe o K = id  finite {(c,d) | c d. 0 < v c  v c  n  f M (v c) = K d}"
  proof (safe, goal_cases)
    case prems: (1 f K)
    then have
      "{(c,d) | c d. 0 < v c  v c  n  f M (v c) = K d}
      = (λ (c,b). (c, theLe b)) ` {(c,K d) | c d. 0 < v c  v c  n  f M (v c) = K d}"
    proof (auto simp add: pointfree_idE, goal_cases)
      case (1 a b)
      then have "(a, K b)  {(c, K d) |c d. 0 < v c  v c  n  f M (v c) = K d}" by auto
      moreover from 1(1) have "theLe (K b) = b" by (simp add: pointfree_idE)
      ultimately show ?case by force
    qed
    moreover from 1 have
      "finite ((λ (c,b). (c, theLe b)) ` {(c,K d) | c d. 0 < v c  v c  n  f M (v c) = K d})"
    by auto
    ultimately show ?case by auto
  qed
  then have finI:
    " f g K. theLe o K = id  finite (g ` {(c,d) | c d. 0 < v c  v c  n  f M (v c) = K d})"
  by auto
  
  have
    "finite ((λ(c,d). - d - u c) ` {(c,d) | c d. 0 < v c  v c  n  M 0 (v c) = Le d})"
  by (rule finI, auto)
  moreover have
    "S_Min_Le = ((λ(c,d). - d - u c) ` {(c,d) | c d. 0 < v c  v c  n  M 0 (v c) = Le d})"
  using S_Min_Le by auto
  ultimately have fin_min_le: "finite S_Min_Le" by auto
  
  have
    "finite ((λ(c,d). - d - u c) ` {(c,d) | c d. 0 < v c  v c  n  M 0 (v c) = Lt d})"
  by (rule finI, auto)
  moreover have
    "S_Min_Lt = ((λ(c,d). - d - u c) ` {(c,d) | c d. 0 < v c  v c  n  M 0 (v c) = Lt d})"
  using S_Min_Lt by auto
  ultimately have fin_min_lt: "finite S_Min_Lt" by auto

  have "finite ((λ(c,d). d - u c) ` {(c,d) | c d. 0 < v c  v c  n  M (v c) 0 = Le d})"
  by (rule finI, auto)
  moreover have
    "S_Max_Le = ((λ(c,d). d - u c) ` {(c,d) | c d. 0 < v c  v c  n  M (v c) 0 = Le d})"
  using S_Max_Le by auto
  ultimately have fin_max_le: "finite S_Max_Le" by auto

  have
    "finite ((λ(c,d). d - u c) ` {(c,d) | c d. 0 < v c  v c  n  M (v c) 0 = Lt d})"
  by (rule finI, auto)
  moreover have
    "S_Max_Lt = ((λ(c,d). d - u c) ` {(c,d) | c d. 0 < v c  v c  n  M (v c) 0 = Lt d})"
  using S_Max_Lt by auto
  ultimately have fin_max_lt: "finite S_Max_Lt" by auto

  { fix x assume "x  S_Min_Le"
    hence "x  0" unfolding S_Min_Le
    proof (safe, goal_cases)
      case (1 c d)
      with A(1) have "- u c  d" unfolding DBM_zone_repr_def DBM_val_bounded_def up_def by auto
      thus ?case by (simp add: minus_le_iff)
    qed
  } note Min_Le_le_0 = this
  have Min_Lt_le_0: "x < 0" if "x  S_Min_Lt" for x using that unfolding S_Min_Lt
  proof (safe, goal_cases)
    case (1 c d)
    with A(1) have "- u c < d" unfolding DBM_zone_repr_def DBM_val_bounded_def up_def by auto
    thus ?case by (simp add: minus_less_iff)
  qed
  text ‹
    The following basically all use the same proof.
    Only the first is not completely identical but nearly identical.
›
  { fix l r assume "l  S_Min_Le" "r  S_Max_Le"
    with S_Min_Le S_Max_Le have "l  r"
    proof (safe, goal_cases)
    case (1 c c' d d')
      note G1 = this
      hence *:"(up M) (v c') (v c) = min (dbm_add (M (v c') 0) (M 0 (v c))) (M (v c') (v c))"
      using A unfolding up_def by (auto split: split_min)
      have "dbm_entry_val u (Some c') (Some c) ((up M) (v c') (v c))"
      using A G1 unfolding DBM_zone_repr_def DBM_val_bounded_def by fastforce
      hence "dbm_entry_val u (Some c') (Some c) (dbm_add (M (v c') 0) (M 0 (v c)))"
      using dbm_entry_dbm_min' * by auto
      hence "u c' - u c  d' + d" using G1 by auto
      hence "u c' + (- u c - d)  d'" by (simp add: add_diff_eq diff_le_eq)
      hence "- u c - d  d' - u c'" by (simp add: add.commute le_diff_eq) 
      thus ?case by (metis add_uminus_conv_diff uminus_add_conv_diff)
    qed
  } note EE = this
  { fix l r assume "l  S_Min_Le" "r  S_Max_Le"
    with S_Min_Le S_Max_Le have "l  r"
    proof (auto, goal_cases)
    case (1 c c' d d')
      note G1 = this
      hence *:"(up M) (v c') (v c) = min (dbm_add (M (v c') 0) (M 0 (v c))) (M (v c') (v c))"
      using A unfolding up_def by (auto split: split_min)
      have "dbm_entry_val u (Some c') (Some c) ((up M) (v c') (v c))"
      using A G1 unfolding DBM_zone_repr_def DBM_val_bounded_def by fastforce
      hence "dbm_entry_val u (Some c') (Some c) (dbm_add (M (v c') 0) (M 0 (v c)))"
      using dbm_entry_dbm_min' * by auto
      hence "u c' - u c  d' + d" using G1 by auto
      hence "u c' + (- u c - d)  d'" by (simp add: add_diff_eq diff_le_eq)
      hence "- u c - d  d' - u c'" by (simp add: add.commute le_diff_eq) 
      thus ?case by (metis add_uminus_conv_diff uminus_add_conv_diff)
    qed
  } note EE = this
  { fix l r assume "l  S_Min_Lt" "r  S_Max_Le"
    with S_Min_Lt S_Max_Le have "l < r"
    proof (auto, goal_cases)
    case (1 c c' d d')
      note G1 = this
      hence *:"(up M) (v c') (v c) = min (dbm_add (M (v c') 0) (M 0 (v c))) (M (v c') (v c))"
      using A unfolding up_def by (auto split: split_min)
      have "dbm_entry_val u (Some c') (Some c) ((up M) (v c') (v c))"
      using A G1 unfolding DBM_zone_repr_def DBM_val_bounded_def by fastforce
      hence "dbm_entry_val u (Some c') (Some c) (dbm_add (M (v c') 0) (M 0 (v c)))"
      using dbm_entry_dbm_min' * by auto
      hence "u c' - u c < d' + d" using G1 by auto
      hence "u c' + (- u c - d) < d'" by (simp add: add_diff_eq diff_less_eq)
      hence "- u c - d < d' - u c'" by (simp add: add.commute less_diff_eq) 
      thus ?case by (metis add_uminus_conv_diff uminus_add_conv_diff)
    qed
  } note LE = this
  { fix l r assume "l  S_Min_Le" "r  S_Max_Lt"
    with S_Min_Le S_Max_Lt have "l < r"
    proof (auto, goal_cases)
    case (1 c c' d d')
      note G1 = this
      hence *:"(up M) (v c') (v c) = min (dbm_add (M (v c') 0) (M 0 (v c))) (M (v c') (v c))"
      using A unfolding up_def by (auto split: split_min)
      have "dbm_entry_val u (Some c') (Some c) ((up M) (v c') (v c))"
      using A G1 unfolding DBM_zone_repr_def DBM_val_bounded_def by fastforce
      hence "dbm_entry_val u (Some c') (Some c) (dbm_add (M (v c') 0) (M 0 (v c)))"
      using dbm_entry_dbm_min' * by auto
      hence "u c' - u c < d' + d" using G1 by auto
      hence "u c' + (- u c - d) < d'" by (simp add: add_diff_eq diff_less_eq)
      hence "- u c - d < d' - u c'" by (simp add: add.commute less_diff_eq) 
      thus ?case by (metis add_uminus_conv_diff uminus_add_conv_diff)
    qed
  } note EL = this
  { fix l r assume "l  S_Min_Lt" "r  S_Max_Lt"
    with S_Min_Lt S_Max_Lt have "l < r"
    proof (auto, goal_cases)
    case (1 c c' d d')
      note G1 = this
      hence *:"(up M) (v c') (v c) = min (dbm_add (M (v c') 0) (M 0 (v c))) (M (v c') (v c))"
      using A unfolding up_def by (auto split: split_min)
      have "dbm_entry_val u (Some c') (Some c) ((up M) (v c') (v c))"
      using A G1 unfolding DBM_zone_repr_def DBM_val_bounded_def by fastforce
      hence "dbm_entry_val u (Some c') (Some c) (dbm_add (M (v c') 0) (M 0 (v c)))"
      using dbm_entry_dbm_min' * by auto
      hence "u c' - u c < d' + d" using G1 by auto
      hence "u c' + (- u c - d) < d'" by (simp add: add_diff_eq diff_less_eq)
      hence "- u c - d < d' - u c'" by (simp add: add.commute less_diff_eq) 
      thus ?case by (metis add_uminus_conv_diff uminus_add_conv_diff)
    qed
  } note LL = this
  obtain m where m: " t  S_Min_Le. m  t" " t  S_Min_Lt. m > t"
                    " t  S_Max_Le. m  t" " t  S_Max_Lt. m < t" "m  0"
  proof -
    assume m:"(m. tS_Min_Le. t  m 
          tS_Min_Lt. t < m  tS_Max_Le. m  t  tS_Max_Lt. m < t  m  0  thesis)"
    let ?min_le = "Max S_Min_Le"
    let ?min_lt = "Max S_Min_Lt" 
    let ?max_le = "Min S_Max_Le"
    let ?max_lt = "Min S_Max_Lt"
    show thesis
    proof (cases "S_Min_Le = {}  S_Min_Lt = {}")
      case True
      note T = this
      show thesis
      proof (cases "S_Max_Le = {}  S_Max_Lt = {}")
        case True
        let ?d' = "0 :: 't :: time"
        show thesis using True T by (intro m[of ?d']) auto
      next
        case False
        let ?d =
          "if S_Max_Le  {}
           then if S_Max_Lt  {} then min ?max_lt ?max_le else ?max_le
           else ?max_lt"
        obtain a :: "'b" where a: "a < 0" using non_trivial_neg by auto
        let ?d' = "min 0 (?d + a)"
        { fix x assume "x  S_Max_Le"
          with fin_max_le a have "min 0 (Min S_Max_Le + a)  x"
          by (metis Min_le add_le_same_cancel1 le_less_trans less_imp_le min.cobounded2 not_less)
          then have "min 0 (Min S_Max_Le + a)  x" by auto
        } note 1 = this
        { fix x assume x: "x  S_Max_Lt"
          have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a) < ?max_lt"
          by (meson a add_less_same_cancel1 min.cobounded1 min.strict_coboundedI2 order.strict_trans2) 
          also from fin_max_lt x have "  x" by auto
          finally have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a) < x" .
        } note 2 = this
        { fix x assume x: "x  S_Max_Le"
          have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a)  ?max_le"
          by (metis le_add_same_cancel1 linear not_le a min_le_iff_disj)
          also from fin_max_le x have "  x" by auto
          finally have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a)  x" .
        } note 3 = this
        show thesis using False T a 1 2 3
        proof ((intro m[of ?d']), auto, goal_cases)
          case 1 then show ?case
          by (metis Min.coboundedI add_less_same_cancel1 dual_order.strict_trans2 fin_max_lt
                    min.boundedE not_le)
        qed
      qed
    next
      case False
      note F = this
      show thesis
      proof (cases "S_Max_Le = {}  S_Max_Lt = {}")
        case True
        let ?d' = "0 :: 't :: time"
        show thesis using True Min_Le_le_0 Min_Lt_le_0 by (intro m[of ?d']) auto
      next
        case False
        let ?r =
          "if S_Max_Le  {}
           then if S_Max_Lt  {} then min ?max_lt ?max_le else ?max_le
           else ?max_lt"
        let ?l =
          "if S_Min_Le  {}
           then if S_Min_Lt  {} then max ?min_lt ?min_le else ?min_le
           else ?min_lt"

        have 1: "x  max ?min_lt ?min_le" "x  ?min_le" if "x  S_Min_Le" for x
        using that fin_min_le by (simp add: max.coboundedI2)+
        
        {
          fix x y assume x: "x  S_Max_Le" "y  S_Min_Lt"
          then have "S_Min_Lt  {}" by auto
          from LE[OF Max_in[OF fin_min_lt], OF this, OF x(1)] have "?min_lt  x" by auto
        } note 3 = this
        
        have 4: "?min_le  x" if "x  S_Max_Le" "y  S_Min_Le" for x y
        using EE[OF Max_in[OF fin_min_le], OF _ that(1)] that by auto
        
        {
          fix x y assume x: "x  S_Max_Lt" "y  S_Min_Lt"
          then have "S_Min_Lt  {}" by auto
          from LL[OF Max_in[OF fin_min_lt], OF this, OF x(1)] have "?min_lt < x" by auto
        } note 5 = this
        {
          fix x y assume x: "x  S_Max_Lt" "y  S_Min_Le"
          then have "S_Min_Le  {}" by auto
          from EL[OF Max_in[OF fin_min_le], OF this, OF x(1)] have "?min_le < x" by auto
        } note 6 = this
        {
          fix x y assume x: "y  S_Min_Le"
          then have "S_Min_Le  {}" by auto
          from Min_Le_le_0[OF Max_in[OF fin_min_le], OF this] have "?min_le  0" by auto
        } note 7 = this
        {
          fix x y assume x: "y  S_Min_Lt"
          then have "S_Min_Lt  {}" by auto
          from Min_Lt_le_0[OF Max_in[OF fin_min_lt], OF this] have "?min_lt < 0" "?min_lt  0" by auto
        } note 8 = this
        show thesis
        proof (cases "?l < ?r")
          case False
          then have *: "S_Max_Le  {}"
          proof (auto, goal_cases)
            case 1
            with ¬ (S_Max_Le = {}  S_Max_Lt = {}) obtain y where y:"y  S_Max_Lt" by auto
            note 1 = 1 this
            { fix x y assume A: "x  S_Min_Le" "y  S_Max_Lt"
                  with EL[OF Max_in[OF fin_min_le] Min_in[OF fin_max_lt]]
                  have "Max S_Min_Le < Min S_Max_Lt" by auto
            } note ** = this
            { fix x y assume A: "x  S_Min_Lt" "y  S_Max_Lt"
                with LL[OF Max_in[OF fin_min_lt] Min_in[OF fin_max_lt]]
                have "Max S_Min_Lt < Min S_Max_Lt" by auto
            } note *** = this
            show ?case
            proof (cases "S_Min_Le  {}")
              case True
              note T = this
              show ?thesis
              proof (cases "S_Min_Lt  {}")
                case True
                then show False using 1 T True ** *** by auto
              next
                case False with 1 T ** show False by auto
              qed
            next
              case False
              with 1 False *** ¬ (S_Min_Le = {}  S_Min_Lt = {}) show ?thesis by auto
            qed
          qed
          { fix x y assume A: "x  S_Min_Lt" "y  S_Max_Lt"
                with LL[OF Max_in[OF fin_min_lt] Min_in[OF fin_max_lt]]
                have "Max S_Min_Lt < Min S_Max_Lt" by auto
            } note *** = this
          { fix x y assume A: "x  S_Min_Lt" "y  S_Max_Le"
                  with LE[OF Max_in[OF fin_min_lt] Min_in[OF fin_max_le]]
                  have "Max S_Min_Lt < Min S_Max_Le" by auto
          } note **** = this
          from F False have **: "S_Min_Le  {}"
          proof (auto, goal_cases)
            case 1
            show ?case
            proof (cases "S_Max_Le  {}")
              case True
              note T = this
              show ?thesis
              proof (cases "S_Max_Lt  {}")
                case True
                then show False using 1 T True **** *** by auto
              next
                case False with 1 T **** show False by auto
              qed
            next
              case False
              with 1 False *** ¬ (S_Max_Le = {}  S_Max_Lt = {}) show ?thesis by auto
            qed
          qed
          {
            fix x assume x: "x  S_Min_Lt"
            then have "x  ?min_lt" using fin_min_lt by (simp add: max.coboundedI2)
            also have "?min_lt < ?min_le"
            proof (rule ccontr, goal_cases)
              case 1
              with x ** have 1: "?l = ?min_lt" by (auto simp: max.absorb1)
              have 2: "?min_lt < ?max_le" using * ****[OF x] by auto
              show False
              proof (cases "S_Max_Lt = {}")
                case False
                then have "?min_lt < ?max_lt" using * ***[OF x] by auto
                with 1 2 have "?l < ?r" by auto
                with ¬ ?l < ?r show False by auto
              next
                case True
                with 1 2 have "?l < ?r" by auto
                with ¬ ?l < ?r show False by auto
              qed
            qed
            finally have "x < max ?min_lt ?min_le" by (simp add: max.strict_coboundedI2) 
          } note 2 = this
          show thesis using F False 1 2 3 4 5 6 7 8 * ** by ((intro m[of ?l]), auto)
        next
          case True
          then obtain d where d: "?l < d" "d < ?r" using dense by auto
          let ?d' = "min 0 d"
          {
            fix t assume "t  S_Min_Le"
            then have "t  ?l" using 1 by auto
            with d have "t  d" by auto
          }
          moreover {
            fix t assume t: "t  S_Min_Lt"
            then have "t  max ?min_lt ?min_le" using fin_min_lt by (simp add: max.coboundedI1)
            with t Min_Lt_le_0 have "t  ?l" using fin_min_lt by auto
            with d have "t < d" by auto
          }
          moreover {
            fix t assume t: "t  S_Max_Le"
            then have "min ?max_lt ?max_le  t" using fin_max_le by (simp add: min.coboundedI2)
            then have "?r  t" using fin_max_le t by auto
            with d have "d  t" by auto
            then have "min 0 d  t" by (simp add: min.coboundedI2)
          }
          moreover {
            fix t assume t: "t  S_Max_Lt"
            then have "min ?max_lt ?max_le  t" using fin_max_lt by (simp add: min.coboundedI1)
            then have "?r  t" using fin_max_lt t by auto
            with d have "d < t" by auto
            then have "min 0 d < t" by (simp add: min.strict_coboundedI2)
          }
          ultimately show thesis using Min_Le_le_0 Min_Lt_le_0 by ((intro m[of ?d']), auto)
        qed
      qed
    qed
  qed
  obtain u' where "u' = (u  m)" by blast
  hence u': "u = (u'  (-m))" unfolding cval_add_def by force
  have "DBM_val_bounded v u' M n" unfolding DBM_val_bounded_def
  proof (auto, goal_cases)
    case 1 with A(1,2) show ?case unfolding DBM_zone_repr_def DBM_val_bounded_def up_def by auto
  next
    case (3 c)
    thus ?case
    proof (cases "M (v c) 0", goal_cases)
      case (1 x1)
      hence "m  x1 - u c" using m(3) S_Max_Le A(2) by blast
      hence "u c + m  x1" by (simp add: add.commute le_diff_eq)
      thus ?case using u' 1(2) unfolding cval_add_def by auto
    next
      case (2 x2)
      hence "m < x2 - u c" using m(4) S_Max_Lt A(2) by blast
      hence "u c + m < x2" by (metis add_less_cancel_left diff_add_cancel gt_swap)
      thus ?case using u' 2(2) unfolding cval_add_def by auto
    next
      case 3 thus ?case by auto
    qed
  next
    case (2 c) thus ?case
    proof (cases "M 0 (v c)", goal_cases)
      case (1 x1)
      hence "- x1 - u c  m" using m(1) S_Min_Le A(2) by blast
      hence "- u c - m  x1" using diff_le_eq neg_le_iff_le by fastforce
      thus ?case using u' 1(2) unfolding cval_add_def by auto
    next
      case (2 x2)
      hence "- x2  - u c < m" using m(2) S_Min_Lt A(2) by blast
      hence "- u c - m < x2" using diff_less_eq neg_less_iff_less by fastforce 
      thus ?case using u' 2(2) unfolding cval_add_def by auto
    next
      case 3 thus ?case by auto
    qed
  next
    case (4 c1 c2)
    from A(2) have "v c1 > 0" "v c2  0" by auto
    then have B: "(up M) (v c1) (v c2) = min (dbm_add (M (v c1) 0) (M 0 (v c2))) (M (v c1) (v c2))"
    unfolding up_def by simp
    
    show ?case
    proof (cases "(dbm_add (M (v c1) 0) (M 0 (v c2))) < (M (v c1) (v c2))")
      case False
      with B have "(up M) (v c1) (v c2) = M (v c1) (v c2)" by (auto split: split_min)
      with A(1) 4 have
        "dbm_entry_val u (Some c1) (Some c2) (M (v c1) (v c2))"
      unfolding DBM_zone_repr_def unfolding DBM_val_bounded_def by fastforce
      thus ?thesis using u' by cases (auto simp add: cval_add_def)
    next
      case True
      with B have "(up M) (v c1) (v c2) = dbm_add (M (v c1) 0) (M 0 (v c2))" by (auto split: split_min)
      with A(1) 4 have
        "dbm_entry_val u (Some c1) (Some c2) (dbm_add (M (v c1) 0) (M 0 (v c2)))"
      unfolding DBM_zone_repr_def unfolding DBM_val_bounded_def by fastforce
      with True dbm_entry_dbm_lt have
        "dbm_entry_val u (Some c1) (Some c2) (M (v c1) (v c2))"
      unfolding less by fast
      thus ?thesis using u' by cases (auto simp add: cval_add_def)
    qed
  qed
  with m(5) u' show ?case by fastforce
qed

section ‹From Clock Constraints to DBMs›

fun And :: "('t :: time) DBM  't DBM  't DBM" where
  "And M1 M2 = (λ i j. min (M1 i j) (M2 i j))"

fun abstr :: "('c, 't::time) cconstraint  't DBM  ('c  nat)  't DBM"
where
  "abstr (AND cc1 cc2) M v = And (abstr cc1 M v) (abstr cc2 M v)" |
  "abstr (EQ c d) M v =
    (λ i j . if i = 0  j = v c then Le (-d) else if i = v c  j = 0 then Le d else M i j)" |
  "abstr (LT c d) M v =
    (λ i j . if i = 0  j = v c then  else if i = v c  j = 0 then Lt d else M i j)" |
  "abstr (LE c d) M v =
    (λ i j . if i = 0  j = v c then  else if i = v c  j = 0 then Le d else M i j)" |
  "abstr (GT c d) M v =
    (λ i j. if i = 0  j = v c then Lt (- d) else if i = v c  j = 0 then  else M i j)" |
  "abstr (GE c d) M v =
    (λ i j. if i = 0  j = v c then Le (- d) else if i = v c  j = 0 then  else M i j)"

lemma abstr_id1:
  "c  collect_clks cc  clock_numbering' v n   c  collect_clks cc. v c  n
     abstr cc M v 0 (v c) = M 0 (v c)"
by (induction cc) auto

lemma abstr_id2:
  "c  collect_clks cc  clock_numbering' v n   c  collect_clks cc. v c  n
     abstr cc M v (v c) 0 = M (v c) 0"
by (induction cc) auto

text ‹
  This lemma is trivial because we constrained our theory to difference constraints.
›

lemma abstr_id3:
  "clock_numbering v  abstr cc M v (v c1) (v c2) = M (v c1) (v c2)"
proof goal_cases
  case 1
  have "c. v c = 0  False"
  proof -
    fix c assume "v c = 0"
    moreover from 1 have "v c > 0" by auto
    ultimately show False by linarith
  qed
  then show ?case by ((induction cc), auto, fastforce)
qed

lemma dbm_abstr_soundness :
  "u  cc; clock_numbering' v n;  c  collect_clks cc. v c  n
     DBM_val_bounded v u (abstr cc (λ i j. ) v) n"
proof (unfold DBM_val_bounded_def, auto, goal_cases)
  case 1
  from this(3) have "abstr cc (λi j. ) v 0 0 = " by (induction cc) auto
  then show ?case unfolding dbm_le_def by auto
next
  case (2 c)
  then have "clock_numbering' v n" by auto
  note A = 2(1) this 2(5,2)
  show ?case
  proof (cases "c  collect_clks cc")
    case True
    then show ?thesis using A(1,4)
    proof (induction rule: collect_clks.induct)
      case (1 cc1 cc2)
      { assume cc: "c  collect_clks cc1" "c  collect_clks cc2"
        with 1 have ?case by auto linarith
      } note both = this
      show ?case
      proof (cases "c  collect_clks cc1")
        case True
        note cc1 = this
        with 1 have *: "dbm_entry_val u None (Some c) (abstr cc1 (λi j. ) v 0 (v c))" by auto
        show ?thesis
        proof (cases "c  collect_clks cc2")
          case True with cc1 both show ?thesis by auto
        next
          case False
          from abstr_id1[OF False A(2)] 1(5)
          have
            "min (abstr cc1 (λi j. ) v 0 (v c)) (abstr cc2 (λi j. ) v 0 (v c))
            = abstr cc1 (λi j. ) v 0 (v c)"
          by (simp add: any_le_inf min.absorb1)
          with * show ?thesis by auto
        qed
      next
        case False
        note cc1 = this
        show ?thesis
        proof (cases "c  collect_clks cc2")
          case True
          with 1 have *: "dbm_entry_val u None (Some c) (abstr cc2 (λi j. ) v 0 (v c))" by auto
          from abstr_id1[OF cc1 A(2)] 1(5)
          have
            "min (abstr cc1 (λi j. ) v 0 (v c)) (abstr cc2 (λi j. ) v 0 (v c))
            = abstr cc2 (λi j. ) v 0 (v c)"
          by (simp add: any_le_inf min.absorb2)
          with * show ?thesis by auto
        next
          case False
          with 1 cc1 show ?thesis by auto
        qed
      qed
    qed auto
  next
    case False
    from abstr_id1[OF this A(2,4)] show ?thesis by auto
  qed
next
  case (3 c)
  then have "clock_numbering' v n" by auto
  note A = 3(1) this 3(5,2)
  from A(2) have gt0: "v c > 0" by auto
  show ?case
  proof (cases "c  collect_clks cc")
    case True
    then show ?thesis using A(1,4)
    proof (induction rule: collect_clks.induct)
      case (1 cc1 cc2)
      { assume cc: "c  collect_clks cc1" "c  collect_clks cc2"
        with 1 have ?case by auto linarith
      } note both = this
      show ?case
      proof (cases "c  collect_clks cc1")
        case True
        note cc1 = this
        with 1 have *: "dbm_entry_val u (Some c) None (abstr cc1 (λi j. ) v (v c) 0)" by auto
        show ?thesis
        proof (cases "c  collect_clks cc2")
          case True with cc1 both show ?thesis by auto
        next
          case False
          from abstr_id2[OF False A(2)] 1(5)
          have
            "min (abstr cc1 (λi j. ) v (v c) 0) (abstr cc2 (λi j. ) v (v c) 0)
            = abstr cc1 (λi j. ) v (v c) 0"
          by (simp add: any_le_inf min.absorb1)
          with * show ?thesis by auto
        qed
      next
        case False
        note cc1 = this
        show ?thesis
        proof (cases "c  collect_clks cc2")
          case True
          with 1 have *: "dbm_entry_val u (Some c) None (abstr cc2 (λi j. ) v (v c) 0)"
          by auto
          from abstr_id2[OF cc1 A(2)] 1(5)
          have
            "min (abstr cc1 (λi j. ) v (v c) 0) (abstr cc2 (λi j. ) v (v c) 0)
            = abstr cc2 (λi j. ) v (v c) 0"
          by (simp add: any_le_inf min.absorb2)
          with * show ?thesis by auto
        next
          case False
          with 1 cc1 show ?thesis by auto
        qed
      qed
    qed (insert gt0, auto)
  next
    case False
    from abstr_id2[OF this A(2,4)] show ?thesis by auto
  qed
next
  text ‹Trivial because of missing difference constraints›
  case (4 c1 c2)
  from abstr_id3[OF this(3)] have "abstr cc (λi j. ) v (v c1) (v c2) = " by auto
  then show ?case by auto
qed

lemma dbm_abstr_completeness:
  "DBM_val_bounded v u (abstr cc (λ i j. ) v) n; c. v c > 0;  c  collect_clks cc. v c  n
     u  cc"
proof (induction cc, goal_cases)
  case (1 cc1 cc2)
  then have AND: "u  [abstr (AND cc1 cc2) (λi j. ) v]v,n" by (simp add: DBM_zone_repr_def)
  from 1 have "i j. i  n  j  n
     (abstr (AND cc1 cc2) (λi j. ) v) i j  (abstr cc1 (λi j. ) v) i j"
  by (simp add: less_eq[symmetric])
  from DBM_le_subset[OF this AND] 1 have "u  cc1" unfolding DBM_zone_repr_def by auto
  from 1 have "i j. i  n  j  n
     (abstr (AND cc1 cc2) (λi j. ) v) i j  (abstr cc2 (λi j. ) v) i j"
  by (simp add: less_eq[symmetric])
  from DBM_le_subset[OF this AND] 1 have "u  cc2" unfolding DBM_zone_repr_def by auto
  from u  cc1 u  cc2 show ?case by auto
next
  case (2 c d)
  from this have "v c  n" by auto
  with 2(1) have "dbm_entry_val u (Some c) None ((abstr (LT c d) (λi j. ) v) (v c) 0)"
  by (auto simp: DBM_val_bounded_def)
  moreover from 2(2) have "v c > 0" by auto
  ultimately show ?case by auto
next
  case (3 c d)
  from this have "v c  n" by auto
  with 3(1) have "dbm_entry_val u (Some c) None ((abstr (LE c d) (λi j. ) v) (v c) 0)"
  by (auto simp: DBM_val_bounded_def)
  moreover from 3(2) have "v c > 0" by auto
  ultimately show ?case by auto
next
  case (4 c d)
  from this have c: "v c > 0" "v c  n" by auto
  with 4(1) have B:
    "dbm_entry_val u (Some c) None ((abstr (EQ c d) (λi j. ) v) (v c) 0)"
    "dbm_entry_val u None (Some c) ((abstr (EQ c d) (λi j. ) v) 0 (v c))"
  by (auto simp: DBM_val_bounded_def)
  from c B have "u c  d" "- u c  -d" by auto
  then show ?case by auto
next
  case (5 c d)
  from this have "v c  n" by auto
  with 5(1) have "dbm_entry_val u None (Some c) ((abstr (GT c d) (λi j. ) v) 0 (v c))"
  by (auto simp: DBM_val_bounded_def)
  moreover from 5(2) have "v c > 0" by auto
  ultimately show ?case by auto
next
  case (6 c d)
  from this have "v c  n" by auto
  with 6(1) have "dbm_entry_val u None (Some c) ((abstr (GE c d) (λi j. ) v) 0 (v c))"
  by (auto simp: DBM_val_bounded_def)
  moreover from 6(2) have "v c > 0" by auto
  ultimately show ?case by auto
qed

lemma dbm_abstr_zone_eq:
  assumes "clock_numbering' v n" "ccollect_clks cc. v c  n"
  shows "[abstr cc (λi j. ) v]v,n = {u. u  cc}"
using dbm_abstr_soundness dbm_abstr_completeness assms unfolding DBM_zone_repr_def by metis


section ‹Zone Intersection›

lemma DBM_and_complete:
  assumes "DBM_val_bounded v u M1 n" "DBM_val_bounded v u M2 n"
  shows "DBM_val_bounded v u (And M1 M2) n"
using assms unfolding DBM_val_bounded_def by (auto simp: min_def)

lemma DBM_and_sound1:
  assumes "DBM_val_bounded v u (And M1 M2) n"
  shows "DBM_val_bounded v u M1 n"
unfolding DBM_val_bounded_def
using assms
proof (safe, goal_cases)
  case 1
  then show ?case unfolding DBM_val_bounded_def by (auto simp: less_eq[symmetric])
next
  case (2 c)
  then have "(And M1 M2) 0 (v c)  M1 0 (v c)" by simp
  from dbm_entry_val_mono_2[folded less_eq, OF _ this, of u] 2 show ?case
  unfolding DBM_val_bounded_def by auto
next
  case (3 c)
  then have "(And M1 M2) (v c) 0  M1 (v c) 0" by simp
  from dbm_entry_val_mono_3[folded less_eq, OF _ this, of u] 3 show ?case
  unfolding DBM_val_bounded_def by auto
next
  case (4 c1 c2)
  then have "(And M1 M2) (v c1) (v c2)  M1 (v c1) (v c2)" by simp
  from dbm_entry_val_mono_1[folded less_eq, OF _ this, of u] 4 show ?case
  unfolding DBM_val_bounded_def by auto
qed

lemma DBM_and_sound2:
  assumes "DBM_val_bounded v u (And M1 M2) n"
  shows "DBM_val_bounded v u M2 n"
unfolding DBM_val_bounded_def
using assms
proof (safe, goal_cases)
  case 1
  then show ?case unfolding DBM_val_bounded_def by (auto simp: less_eq[symmetric])
next
  case (2 c)
  then have "(And M1 M2) 0 (v c)  M2 0 (v c)" by simp
  from dbm_entry_val_mono_2[folded less_eq, OF _ this, of u] 2 show ?case
  unfolding DBM_val_bounded_def by auto
next
  case (3 c)
  then have "(And M1 M2) (v c) 0  M2 (v c) 0" by simp
  from dbm_entry_val_mono_3[folded less_eq, OF _ this, of u] 3 show ?case
  unfolding DBM_val_bounded_def by auto
next
  case (4 c1 c2)
  then have "(And M1 M2) (v c1) (v c2)  M2 (v c1) (v c2)" by simp
  from dbm_entry_val_mono_1[folded less_eq, OF _ this, of u] 4 show ?case
  unfolding DBM_val_bounded_def by auto
qed


section ‹Clock Reset›

definition
  DBM_reset :: "('t :: time) DBM  nat  nat  't  't DBM  bool"
where
  "DBM_reset M n k d M' 
    ( j  n. 0 < j  k  j M' k j =    M' j k =  )  M' k 0 = Le d  M' 0 k = Le (- d)
     M' k k = M k k
     (i  n. j  n.
        i  k  j  k  M' i j = min (dbm_add (M i k) (M k j)) (M i j))"


lemma DBM_reset_mono:
  assumes "DBM_reset M n k d M'" "i  n" "j  n" "i  k" "j  k"
  shows "M' i j  M i j"
using assms unfolding DBM_reset_def by auto

lemma DBM_reset_len_mono:
  assumes "DBM_reset M n k d M'" "k  set xs" "i  k" "j  k" "set (i # j # xs)  {0..n}"
  shows "len M' i j xs  len M i j xs"
using assms by (induction xs arbitrary: i) (auto intro: add_mono DBM_reset_mono)

lemma DBM_reset_neg_cycle_preservation:
  assumes "DBM_reset M n k d M'" "len M i i xs < Le 0" "set (k # i # xs)  {0..n}"
  shows " j.  ys. set (j # ys)  {0..n}  len M' j j ys < Le 0"
proof (cases "xs = []")
  case Nil: True
  show ?thesis
  proof (cases "k = i")
    case True
    with Nil assms have "len M' i i [] < Le 0" unfolding DBM_reset_def by auto
    moreover from assms have "set (i # [])  {0..n}" by auto
    ultimately show ?thesis by blast
  next
    case False
    with Nil assms DBM_reset_mono have "len M' i i [] < Le 0" by fastforce
    moreover from assms have "set (i # [])  {0..n}" by auto
    ultimately show ?thesis by blast
  qed
next
  case False
  with assms obtain j ys where cycle:
    "len M j j ys < Le 0" "distinct (j # ys)" "j  set (i # xs)" "set ys  set xs"
  by (metis negative_len_shortest neutral)
  show ?thesis
  proof (cases "k  set (j # ys)")
    case False
    with cycle assms have "len M' j j ys  len M j j ys" by - (rule DBM_reset_len_mono, auto)
    moreover from cycle assms have "set (j # ys)  {0..n}" by auto
    ultimately show ?thesis using cycle(1) by fastforce
  next
    case True
    then obtain l where l: "(l, k)  set (arcs j j ys)"
    proof (cases "j = k", goal_cases)
      case True
      show ?thesis
      proof (cases "ys = []")
        case T: True
        with True show ?thesis by (auto intro: that)
      next
        case False
        then obtain z zs where "ys = zs @ [z]" by (metis append_butlast_last_id)
        from arcs_decomp[OF this] True show ?thesis by (auto intro: that)
      qed
    next
      case False
      from arcs_set_elem2[OF False True] show ?thesis by (blast intro: that)
    qed
    show ?thesis
    proof (cases "ys = []")
      case False
      from cycle_rotate_2'[OF False l, of M] cycle(1) obtain zs where rotated:
        "len M l l (k # zs) < Le 0" "set (l # k # zs) = set (j # ys)" "1 + length zs = length ys"
      by auto
      with length_eq_distinct[OF this(2)[symmetric] cycle(2)] have "distinct (l # k # zs)" by auto
      note rotated = rotated(1,2) this
      from this(2) cycle(3,4) assms(3) have n_bound: "set (l # k # zs)  {0..n}" by auto
      then have "l  n" by auto
      show ?thesis
      proof (cases zs)
        case Nil
        with rotated have "M l k + M k l < Le 0" "l  k"  by auto
        with assms(1) l  n have "M' l l < Le 0" unfolding DBM_reset_def mult min_def by auto
        with l  n have "len M' l l [] < Le 0" "set [l]  {0..n}" by auto
        then show ?thesis by blast
      next
        case (Cons w ws)
        with n_bound have *: "set (w # l # ws)  {0..n}" by auto
        from Cons n_bound rotated(3) have "w  n" "w  k" "l  k" by auto
        with assms(1) l  n have
          "M' l w  M l k + M k w"
        unfolding DBM_reset_def mult min_def by auto
        moreover from Cons rotated assms * have
          "len M' w l ws  len M w l ws"
        by - (rule DBM_reset_len_mono, auto)
        ultimately have
          "len M' l l zs  len M l l (k # zs)"
        using Cons by (auto intro: add_mono simp add: assoc[symmetric])
        with n_bound rotated(1) show ?thesis by fastforce
      qed
    next
      case T: True
      with True cycle have "M j j < Le 0" "j = k" by auto
      with assms(1) have "len M' k k [] < Le 0" unfolding DBM_reset_def by simp
      moreover from assms(3) have "set (k # [])  {0..n}" by auto
      ultimately show ?thesis by blast
    qed
  qed
qed

text ‹Implementation of DBM reset›

definition reset :: "('t::time) DBM  nat  nat  't  't DBM"
where
  "reset M n k d =
    (λ i j.
        if i = k  j = 0 then Le d
        else if i = 0  j = k then Le (-d)
        else if i = k  j  k then 
        else if i  k  j = k then 
        else if i = k  j = k then M k k
        else min (dbm_add (M i k) (M k j)) (M i j)
       )"

fun reset' :: "('t::time) DBM  nat  'c list  ('c  nat)  't  't DBM"
where
  "reset' M n [] v d = M" |
  "reset' M n (c # cs) v d = reset (reset' M n cs v d) n (v c) d"

lemma DBM_reset_reset:
  "0 < k  k  n  DBM_reset M n k d (reset M n k d)"
unfolding DBM_reset_def by (auto simp: reset_def)

lemma DBM_reset_complete:
  assumes "clock_numbering' v n" "v c  n" "DBM_reset M n (v c) d M'" "DBM_val_bounded v u M n"
  shows "DBM_val_bounded v (u(c := d)) M' n"
unfolding DBM_val_bounded_def using assms
proof (auto, goal_cases)
  case 1
  then have *: "M 0 0  Le 0" unfolding DBM_val_bounded_def less_eq by auto
  from 1 have **: "M' 0 0 = min (M 0 (v c) + M (v c) 0) (M 0 0)" unfolding DBM_reset_def mult by auto
  show ?case
  proof (cases "M 0 (v c) + M (v c) 0  M 0 0")
    case False
    with * ** show ?thesis unfolding min_def less_eq by auto
  next
    case True
    have "dbm_entry_val u (Some c) (Some c) (M (v c) 0 + M 0 (v c))"
    by (metis DBM_val_bounded_def assms(2,4) dbm_entry_val_add_4 mult)
    then have "M (v c) 0 + M 0 (v c)  Le 0"
    unfolding less_eq dbm_le_def by (cases "M (v c) 0 + M 0 (v c)") auto
    with True ** have "M' 0 0  Le 0" by (simp add: comm)
    then show ?thesis unfolding less_eq .
  qed
next
  case (2 c')
  show ?case
  proof (cases "c = c'")
    case False
    hence F:"v c'  v c" using 2 by metis
    hence *:"M' 0 (v c') = min (dbm_add (M 0 (v c)) (M (v c) (v c'))) (M 0 (v c'))"
    using F 2(1,2,4,6) unfolding DBM_reset_def by simp
    show ?thesis
    proof (cases "dbm_add (M 0 (v c)) (M (v c) (v c')) < M 0 (v c')")
      case False
      with * have "M' 0 (v c') = M 0 (v c')" by (auto split: split_min)
      hence "dbm_entry_val u None (Some c') (M' 0 (v c'))"
      using 2(3,6) unfolding DBM_val_bounded_def by auto
      thus ?thesis using F by cases fastforce+
    next
      case True
      with * have **:"M' 0 (v c') = dbm_add (M 0 (v c)) (M (v c) (v c'))" by (auto split: split_min)
      from 2 have "dbm_entry_val u None (Some c) (M 0 (v c))"
      "dbm_entry_val u (Some c) (Some c') (M (v c) (v c'))"
      unfolding DBM_val_bounded_def by auto
      thus ?thesis
      proof (cases, auto simp add: **, goal_cases)
        case (1 d)
        note G1 = this
        from this(2) show ?case
        proof (cases, goal_cases)
          case (1 d')
          from this(2) G1(3) have "- u c'  d + d'"
          by (metis diff_minus_eq_add less_diff_eq less_le_trans minus_diff_eq minus_le_iff not_le)
          thus ?case using 1 c  c' by fastforce
        next
          case (2 d')
          from this(2) G1(3) have "u c - u c' - u c < d + d'" using add_le_less_mono by fastforce
          hence "- u c' < d + d'" by simp
          thus ?case using 2 c  c' by fastforce
        next
          case (3) thus ?case by auto
        qed
      next
        case (2 d)
        note G2 = this
        from this(2) show ?case
        proof (cases, goal_cases)
          case (1 d')
          from this(2) G2(3) have "u c - u c' - u c < d' + d" using add_le_less_mono by fastforce
          hence "- u c' < d' + d" by simp
          hence "- u c' < d + d'"
          by (metis (hide_lams, no_types) diff_0_right diff_minus_eq_add minus_add_distrib minus_diff_eq)
          thus ?case using 1 c  c' by fastforce
        next
          case (2 d')
          from this(2) G2(3) have "u c - u c' - u c < d + d'" using add_strict_mono by fastforce
          hence "- u c' < d + d'" by simp
          thus ?case using 2 c  c' by fastforce
        next
          case (3) thus ?case by auto
        qed
      qed
    qed
  next
    case True
    with 2 show ?thesis unfolding DBM_reset_def by auto
  qed
next
  case (3 c')
  show ?case
  proof (cases "c = c'")
    case False
    hence F:"v c'  v c" using 3 by metis
    hence *:"M' (v c') 0 = min (dbm_add (M (v c') (v c)) (M (v c) 0)) (M (v c') 0)"
    using F 3(1,2,4,6) unfolding DBM_reset_def by simp
    show ?thesis
    proof (cases "dbm_add (M (v c') (v c)) (M (v c) 0) < M (v c') 0")
      case False
      with * have "M' (v c') 0 = M (v c') 0" by (auto split: split_min)
      hence "dbm_entry_val u (Some c') None (M' (v c') 0)"
      using 3(3,6) unfolding DBM_val_bounded_def by auto
      thus ?thesis using F by cases fastforce+
    next
      case True
      with * have **:"M' (v c') 0 = dbm_add (M (v c') (v c)) (M (v c) 0)" by (auto split: split_min)
      from 3 have "dbm_entry_val u (Some c') (Some c) (M (v c') (v c))"
      "dbm_entry_val u (Some c) None (M (v c) 0)"
      unfolding DBM_val_bounded_def by auto
      thus ?thesis
      proof (cases, auto simp add: **, goal_cases)
        case (1 d)
        note G1 = this
        from this(2) show ?case
        proof (cases, goal_cases)
          case (1 d')
          from this(2) G1(3) have "u c'  d + d'" using ordered_ab_semigroup_add_class.add_mono
          by fastforce 
          thus ?case using 1 c  c' by fastforce
        next
          case (2 d')
          from this(2) G1(3) have "u c + u c' - u c < d + d'" using add_le_less_mono by fastforce
          hence "u c' < d + d'" by simp
          thus ?case using 2 c  c' by fastforce
        next
          case (3) thus ?case by auto
        qed
      next
        case (2 d)
        note G2 = this
        from this(2) show ?case
        proof (cases, goal_cases)
          case (1 d')
          from this(2) G2(3) have "u c + u c' - u c < d' + d" using add_le_less_mono by fastforce
          hence "u c' < d' + d" by simp
          hence "u c' < d + d'"
          by (metis (hide_lams, no_types) diff_0_right diff_minus_eq_add minus_add_distrib minus_diff_eq)
          thus ?case using 1 c  c' by fastforce
        next
          case (2 d')
          from this(2) G2(3) have "u c + u c' - u c < d + d'" using add_strict_mono by fastforce
          hence "u c' < d + d'" by simp
          thus ?case using 2 c  c' by fastforce
        next
          case 3 thus ?case by auto
        qed
      qed
    qed
  next
    case True
    with 3 show ?thesis unfolding DBM_reset_def by auto
  qed
next
  case (4 c1 c2)
  show ?case
  proof (cases "c = c1")
    case False
    note F1 = this
    show ?thesis
    proof (cases "c = c2")
      case False
      with F1 4 have F: "v c  v c1" "v c  v c2" "v c1  0" "v c2  0" by force+
      hence *:"M' (v c1) (v c2) = min (dbm_add (M (v c1) (v c)) (M (v c) (v c2))) (M (v c1) (v c2))"
      using 4(1,2,6,7) unfolding DBM_reset_def by simp
      show ?thesis
      proof (cases "dbm_add (M (v c1) (v c)) (M (v c) (v c2)) < M (v c1) (v c2)")
        case False
        with * have "M' (v c1) (v c2) = M (v c1) (v c2)" by (auto split: split_min)
        hence "dbm_entry_val u (Some c1) (Some c2) (M' (v c1) (v c2))"
        using 4(3,6,7) unfolding DBM_val_bounded_def by auto
        thus ?thesis using F by cases fastforce+
      next
        case True
        with * have **:"M' (v c1) (v c2) = dbm_add (M (v c1) (v c)) (M (v c) (v c2))" by (auto split: split_min)
        from 4 have "dbm_entry_val u (Some c1) (Some c) (M (v c1) (v c))"
        "dbm_entry_val u (Some c) (Some c2) (M (v c) (v c2))" unfolding DBM_val_bounded_def by auto
        thus ?thesis
        proof (cases, auto simp add: **, goal_cases)
          case (1 d)
          note G1 = this
          from this(2) show ?case
          proof (cases, goal_cases)
            case (1 d')
            from this(2) G1(3) have "u c1 - u c2  d + d'"
            by (metis (hide_lams, no_types) ab_semigroup_add_class.add_ac(1) add_le_cancel_right
                                  add_left_mono diff_add_cancel dual_order.refl dual_order.trans)
            thus ?case using 1 c  c1 c  c2 by fastforce
          next
            case (2 d')
            from add_less_le_mono[OF this(2) G1(3)] have "- u c2 + u c1 < d' + d" by simp
            hence "u c1 - u c2 < d + d'" by (simp add: add.commute) 
            thus ?case using 2 c  c1 c  c2 by fastforce
          next
            case (3) thus ?case by auto
          qed
        next
          case (2 d)
          note G2 = this
          from this(2) show ?case
          proof (cases, goal_cases)
            case (1 d')
            from add_less_le_mono[OF G2(3) this(2)] have "u c1 - u c2 < d + d'"
            by (metis (hide_lams, no_types) ab_semigroup_add_class.add_ac(1) add_le_cancel_right
              diff_add_cancel dual_order.order_iff_strict dual_order.strict_trans2)
            thus ?case using 1 c  c1 c  c2 by fastforce
          next
            case (2 d')
            from add_strict_mono[OF this(2) G2(3)] have "- u c2 + u c1 < d' + d" by simp
            hence "- u c2 + u c1 < d + d'"
            by (metis (full_types) diff_0 diff_minus_eq_add minus_add_distrib minus_diff_eq)
            hence "u c1 - u c2 < d + d'" by (metis add_diff_cancel_left diff_0 diff_0_right diff_add_cancel)
            thus ?case using 2 c  c1 c  c2 by fastforce
          next
            case (3) thus ?case by auto
          qed
        qed
      qed
    next
      case True
      with F1 4 have F: "v c  v c1" "v c1  0" "v c2  0" by force+
      thus ?thesis using 4(1,2,4,6,7) True unfolding DBM_reset_def by auto
    qed
  next
    case True
    note T1 = this
    show ?thesis
    proof (cases "c = c2")
      case False
      with T1 4 have F: "v c  v c2" "v c1  0" "v c2  0" by force+
      thus ?thesis using 4(1,2,7) True unfolding DBM_reset_def by auto
    next
      case True
      then have *: "M' (v c1) (v c1) = M (v c1) (v c1)"
      using T1 4 unfolding DBM_reset_def by auto
      from 4(1,3) True T1 have "dbm_entry_val u (Some c1) (Some c2) (M (v c1) (v c2))"
      unfolding DBM_val_bounded_def by auto
      then show ?thesis by (cases rule: dbm_entry_val.cases, auto simp: * True[symmetric] T1)
    qed
  qed
qed

lemma DBM_reset_sound_empty:
  assumes "clock_numbering' v n" "v c  n" "DBM_reset M n (v c) d M'"
          " u . ¬ DBM_val_bounded v u M' n"
  shows "¬ DBM_val_bounded v u M n"
using assms DBM_reset_complete by metis

lemma DBM_reset_diag_preservation:
  "kn. M k k  𝟭  DBM_reset M n i d M'  kn. M' k k  𝟭"
  apply auto
  apply (case_tac "k = i")
   apply (simp add: DBM_reset_def less[symmetric])
  apply (case_tac "k = 0")
by (auto simp add: DBM_reset_def less[symmetric] neutral split: split_min)

lemma FW_diag_preservation:
  "kn. M k k  𝟭  kn. (FW M n) k k  𝟭"
proof clarify
  fix k assume A: "kn. M k k  𝟭" "k  n"
  then have "M k k  𝟭" by auto
  with fw_mono[of n n n k k M n] A show "FW M n k k  𝟭" by auto
qed

lemma DBM_reset_not_cyc_free_preservation:
  assumes "¬ cyc_free M n" "DBM_reset M n k d M'" "k  n"
  shows "¬ cyc_free M' n"
proof -
  from assms(1) obtain i xs where "i  n" "set xs  {0..n}" "len M i i xs < Le 0"
  unfolding neutral by auto
  with DBM_reset_neg_cycle_preservation[OF assms(2) this(3)] assms(3) obtain j ys where
    "set (j # ys)  {0..n}" "len M' j j ys < Le 0"
  by auto
  then show ?thesis unfolding neutral by force
qed

lemma DBM_reset_complete_empty':
  assumes "kn. k > 0  (c. v c = k)" "clock_numbering v" "k  n"
          "DBM_reset M n k d M'" " u . ¬ DBM_val_bounded v u M n"
  shows "¬ DBM_val_bounded v u M' n"
proof -
  from assms(5) have "[M]v,n = {}" unfolding DBM_zone_repr_def by auto
  from empty_not_cyc_free[OF _ this] have "¬ cyc_free M n" using assms(2) by auto
  from DBM_reset_not_cyc_free_preservation[OF this assms(4,3)] have "¬ cyc_free M' n" by auto
  then obtain i xs where "i  n" "set xs  {0..n}" "len M' i i xs < 𝟭" by auto
  from DBM_val_bounded_neg_cycle[OF _ this assms(1)] show ?thesis by fast
qed

lemma DBM_reset_complete_empty:
  assumes "kn. k > 0  (c. v c = k)" "clock_numbering v"
          "DBM_reset (FW M n) n (v c) d M'" " u . ¬ DBM_val_bounded v u (FW M n) n"
  shows "¬ DBM_val_bounded v u M' n"
proof -
  note A = assms
  from A(4) have "[FW M n]v,n = {}" unfolding DBM_zone_repr_def by auto
  with FW_detects_empty_zone[OF A(1), of M] A(2)
  obtain i where i: "i  n" "FW M n i i < Le 0" by blast
  with A(3,4) have "M' i i < Le 0"
  unfolding DBM_reset_def by (cases "i = v c", auto split: split_min)
  with fw_mono[of n n n i i M' n] i have "FW M' n i i < Le 0" by auto
  with FW_detects_empty_zone[OF A(1), of M'] A(2) i
  have "[FW M' n]v,n = {}" by auto
  with FW_zone_equiv[OF A(1)] show ?thesis by (auto simp: DBM_zone_repr_def)
qed

lemma DBM_reset_complete_empty1:
  assumes "kn. k > 0  (c. v c = k)" "clock_numbering v"
          "DBM_reset (FW M n) n (v c) d M'" " u . ¬ DBM_val_bounded v u M n"
  shows "¬ DBM_val_bounded v u M' n"
proof -
  from assms have "[M]v,n = {}" unfolding DBM_zone_repr_def by auto
  with FW_zone_equiv[OF assms(1)] have
    " u . ¬ DBM_val_bounded v u (FW M n) n"
  unfolding DBM_zone_repr_def by auto
  from DBM_reset_complete_empty[OF assms(1-3) this] show ?thesis by auto
qed

text ‹
  Lemma FW_canonical_id› allows us to prove correspondences between reset and canonical,
  like for the two below.
  Can be left out for the rest because of the triviality of the correspondence.
›

lemma DBM_reset_empty'':
  assumes "kn. k > 0  (c. v c = k)" "clock_numbering' v n" "v c  n"
          "DBM_reset M n (v c) d M'"
  shows "[M]v,n = {}  [M']v,n = {}"
proof
  assume A: "[M]v,n = {}"
  hence " u . ¬ DBM_val_bounded v u M n" unfolding DBM_zone_repr_def by auto
  hence " u . ¬ DBM_val_bounded v u M' n"
  using DBM_reset_complete_empty'[OF assms(1) _ assms(3,4)] assms(2) by auto
  thus "[M']v,n = {}" unfolding DBM_zone_repr_def by auto
next
  assume "[M']v,n = {}"
  hence " u . ¬ DBM_val_bounded v u M' n" unfolding DBM_zone_repr_def by auto
  hence " u . ¬ DBM_val_bounded v u M n" using DBM_reset_sound_empty[OF assms(2-4)] by auto
  thus "[M]v,n = {}" unfolding DBM_zone_repr_def by auto
qed

lemma DBM_reset_empty:
  assumes "kn. k > 0  (c. v c = k)" "clock_numbering' v n" "v c  n"
          "DBM_reset (FW M n) n (v c) d M'"
  shows "[FW M n]v,n = {}  [M']v,n = {}"
proof
  assume A: "[FW M n]v,n = {}"
  hence " u . ¬ DBM_val_bounded v u (FW M n) n" unfolding DBM_zone_repr_def by auto
  hence " u . ¬ DBM_val_bounded v u M' n"
  using DBM_reset_complete_empty[of n v M, OF assms(1) _ assms(4)] assms(2,3) by auto
  thus "[M']v,n = {}" unfolding DBM_zone_repr_def by auto
next
  assume "[M']v,n = {}"
  hence " u . ¬ DBM_val_bounded v u M' n" unfolding DBM_zone_repr_def by auto
  hence " u . ¬ DBM_val_bounded v u (FW M n) n" using DBM_reset_sound_empty[OF assms(2-)] by auto
  thus "[FW M n]v,n = {}" unfolding DBM_zone_repr_def by auto
qed

lemma DBM_reset_empty':
  assumes "canonical M n" "kn. k > 0  (c. v c = k)" "clock_numbering' v n" "v c  n"
          "DBM_reset (FW M n) n (v c) d M'"
  shows   "[M]v,n = {}  [M']v,n = {}"
using FW_canonical_id[OF assms(1)] DBM_reset_empty[OF assms(2-)] by simp

lemma DBM_reset_sound':
  assumes "clock_numbering' v n" "v c  n" "DBM_reset M n (v c) d M'" "DBM_val_bounded v u M' n"
          "DBM_val_bounded v u'' M n"
  obtains d' where  "DBM_val_bounded v (u(c := d')) M n"
using assms
proof (auto, goal_cases)
  case 1
  note A = this
  obtain S_Min_Le where S_Min_Le:
  "S_Min_Le = {u c' - d | c' d. 0 < v c'  v c'  n  c  c'  M (v c') (v c) = Le d}
                {-d | d. M 0 (v c) = Le d}" by auto
  obtain S_Min_Lt where S_Min_Lt:
  "S_Min_Lt = {u c' - d | c' d. 0 < v c'  v c'  n  c  c'  M (v c') (v c) = Lt d}
               {-d | d. M 0 (v c) = Lt d}" by auto
  obtain S_Max_Le where S_Max_Le:
  "S_Max_Le = {u c' + d | c' d. 0 < v c'  v c'  n  c  c'  M (v c) (v c') = Le d}
               {d | d. M (v c) 0 = Le d}" by auto
  obtain S_Max_Lt where S_Max_Lt:
  "S_Max_Lt = {u c' + d | c' d. 0 < v c'  v c'  n  c  c'  M (v c) (v c') = Lt d}
               {d | d. M (v c) 0 = Lt d}" by auto

  have "finite {c. 0 < v c  v c  n}" using A(6,7)
  proof (induction n)
    case 0
    then have "{c. 0 < v c  v c  0} = {}" by auto
    then show ?case by (metis finite.emptyI) 
  next
    case (Suc n)
    then have "finite {c. 0 < v c  v c  n}" by auto
    moreover have "{c. 0 < v c  v c  Suc n} = {c. 0 < v c  v c  n}  {c. v c = Suc n}" by auto
    moreover have "finite {c. v c = Suc n}"
    proof (cases "{c. v c = Suc n} = {}", auto)
      fix c assume "v c = Suc n"
      then have "{c. v c = Suc n} = {c}" using Suc.prems(2) by auto
      then show ?thesis by auto
    qed
    ultimately show ?case by auto
  qed
  then have " f. finite {(c,b) | c b. 0 < v c  v c  n  f M (v c) = b}" by auto
  moreover have
    " f K. {(c,K d) | c d. 0 < v c  v c  n  f M (v c) = K d}
     {(c,b) | c b. 0 < v c  v c  n  f M (v c) = b}"
  by auto
  ultimately have B:
    " f K. finite {(c,K d) | c d. 0 < v c  v c  n  f M (v c) = K d}"
  using finite_subset by fast
  have " f K. theLe o K = id  finite {(c,d) | c d. 0 < v c  v c  n  f M (v c) = K d}"
  proof (auto, goal_cases)
    case (1 f K)
    then have
      "{(c,d) | c d. 0 < v c  v c  n  f M (v c) = K d}
      = (λ (c,b). (c, theLe b)) ` {(c,K d) | c d. 0 < v c  v c  n  f M (v c) = K d}"
    proof (auto simp add: pointfree_idE, goal_cases)
      case (1 a b)
      then have "(a, K b)  {(c, K d) |c d. 0 < v c  v c  n  f M (v c) = K d}" by auto
      moreover from 1(1) have "theLe (K b) = b" by (simp add: pointfree_idE)
      ultimately show ?case by force
    qed
    moreover from B have
      "finite ((λ (c,b). (c, theLe b)) ` {(c,K d) | c d. 0 < v c  v c  n  f M (v c) = K d})"
    by auto
    ultimately show ?case by auto
  qed
  then have finI:
    " f g K. theLe o K = id  finite (g ` {(c',d) | c' d. 0 < v c'  v c'  n  f M (v c') = K d})"
  by auto
  have finI1:
    " f g K. theLe o K = id  finite (g ` {(c',d) | c' d. 0 < v c'  v c'  n  c  c'  f M (v c') = K d})"
  proof goal_cases
    case (1 f g K)
    have
      "g ` {(c',d) | c' d. 0 < v c'  v c'  n  c  c'  f M (v c') = K d}
       g ` {(c',d) | c' d. 0 < v c'  v c'  n  f M (v c') = K d}"
    by auto
    from finite_subset[OF this finI[OF 1, of g f]] show ?case .
  qed
  have " f. finite {b. f M (v c) = b}" by auto
  moreover have " f K. {K d | d. f M (v c) = K d}  {b. f M (v c) = b}" by auto
  ultimately have B: " f K. finite {K d | d. f M (v c) = K d}" using finite_subset by fast

  have " f K. theLe o K = id  finite {d | d. f M (v c) = K d}"
  proof (auto, goal_cases)
    case (1 f K)
    then have "{d | d. f M (v c) = K d} = theLe ` {K d | d. f M (v c) = K d}"
    proof (auto simp add: pointfree_idE, goal_cases)
      case (1 x)
      have "K x  {K d |d. K x = K d}" by auto
      moreover from 1 have "theLe (K x) = x"  by (simp add: pointfree_idE)
      ultimately show ?case by auto
    qed
    moreover from B have "finite {K d |d. f M (v c) = K d}" by auto
    ultimately show ?case by auto
  qed
  then have C: " f g K. theLe o K = id  finite (g ` {d | d. f M (v c) = K d})" by auto
  have finI2: " f g K. theLe o K = id  finite ({g d | d. f M (v c) = K d})"
  proof goal_cases
    case (1 f g K)
    have "{g d |d. f M (v c) = K d} = g ` {d | d. f M (v c) = K d}" by auto
    with C 1 show ?case by auto
  qed

  { fix K :: "'b  'b DBMEntry" assume A: "theLe o K = id"
    then have
      "finite ((λ(c,d). u c - d) ` {(c',d) | c' d. 0 < v c'  v c'  n  c  c'  M (v c') (v c) = K d})"
    by (intro finI1, auto)
    moreover have
      "{u c' - d |c' d. 0 < v c'  v c'  n  c  c'  M (v c') (v c) = K d}
      = ((λ(c,d). u c - d) ` {(c',d) | c' d. 0 < v c'  v c'  n  c  c'  M (v c') (v c) = K d})"
    by auto
    ultimately have "finite {u c' - d |c' d. 0 < v c'  v c'  n  c  c'  M (v c') (v c) = K d}"
    by auto
    moreover have "finite {- d |d. M 0 (v c) = K d}" using A by (intro finI2, auto)
    ultimately have
      "finite ({u c' - d |c' d. 0 < v c'  v c'  n  c  c'  M (v c') (v c) = K d}
                 {- d |d. M 0 (v c) = K d})"
    by (auto simp: S_Min_Le)
  } note fin1 = this
  have fin_min_le: "finite S_Min_Le" unfolding S_Min_Le by (rule fin1, auto)
  have fin_min_lt: "finite S_Min_Lt" unfolding S_Min_Lt by (rule fin1, auto)

  { fix K :: "'b  'b DBMEntry" assume A: "theLe o K = id"
    then have "finite ((λ(c,d). u c + d) ` {(c',d) | c' d. 0 < v c'  v c'  n  c  c'  M (v c) (v c') = K d})"
    by (intro finI1, auto)
    moreover have
      "{u c' + d |c' d. 0 < v c'  v c'  n  c  c'  M (v c) (v c') = K d}
      = ((λ(c,d). u c + d) ` {(c',d) | c' d. 0 < v c'  v c'  n  c  c'  M (v c) (v c') = K d})"
    by auto
    ultimately have "finite {u c' + d |c' d. 0 < v c'  v c'  n  c  c'  M (v c) (v c') = K d}"
    by auto
    moreover have "finite {d |d. M (v c) 0 = K d}" using A by (intro finI2, auto)
    ultimately have
      "finite ({u c' + d |c' d. 0 < v c'  v c'  n  c  c'  M (v c) (v c') = K d}
                {d |d. M (v c) 0 = K d})"
    by (auto simp: S_Min_Le)
  } note fin2 = this
  have fin_max_le: "finite S_Max_Le" unfolding S_Max_Le by (rule fin2, auto)
  have fin_max_lt: "finite S_Max_Lt" unfolding S_Max_Lt by (rule fin2, auto)

  { fix l r assume "l  S_Min_Le" "r  S_Max_Le"
    then have "l  r"
    proof (auto simp: S_Min_Le S_Max_Le, goal_cases)
      case (1 c1 d1 c2 d2)
      with A have
        "dbm_entry_val u (Some c1) (Some c2) (M' (v c1) (v c2))"
      unfolding DBM_val_bounded_def by presburger
      moreover have
        "M' (v c1) (v c2) = min (dbm_add (M (v c1) (v c)) (M (v c) (v c2))) (M (v c1) (v c2))"
      using A(3,7) 1 unfolding DBM_reset_def by metis
      ultimately have
        "dbm_entry_val u (Some c1) (Some c2) (dbm_add (M (v c1) (v c)) (M (v c) (v c2)))"
      using dbm_entry_dbm_min' by auto 
      with 1 have "u c1 - u c2  d1 + d2" by auto
      thus ?case
      by (metis (hide_lams, no_types) add_diff_cancel_left diff_0_right diff_add_cancel diff_eq_diff_less_eq)
    next
      case (2 c' d)
      with A have
        "(in. i  v c  i > 0  M' i 0 = min (dbm_add (M i (v c)) (M (v c) 0)) (M i 0))"
        "v c'  v c"
      unfolding DBM_reset_def by auto
      hence "(M' (v c') 0 = min (dbm_add (M (v c') (v c)) (M (v c) 0)) (M (v c') 0))"
      using 2 by blast 
      moreover from A 2 have "dbm_entry_val u (Some c') None (M' (v c') 0)"
      unfolding DBM_val_bounded_def by presburger
      ultimately have "dbm_entry_val u (Some c') None (dbm_add (M (v c') (v c)) (M (v c) 0))"
      using dbm_entry_dbm_min3' by fastforce
      with 2 have "u c'  d + r" by auto
      thus ?case by (metis add_diff_cancel_left add_le_cancel_right diff_0_right diff_add_cancel)
    next
      case (3 d c' d')
      with A have
        "(in. i  v c  i > 0  M' 0 i = min (dbm_add (M 0 (v c)) (M (v c) i)) (M 0 i))"
        "v c'  v c"
      unfolding DBM_reset_def by auto
      hence "(M' 0 (v c') = min (dbm_add (M 0 (v c)) (M (v c) (v c'))) (M 0 (v c')))"
      using 3 by blast 
      moreover from A 3 have "dbm_entry_val u None (Some c') (M' 0 (v c'))"
      unfolding DBM_val_bounded_def by presburger
      ultimately have "dbm_entry_val u None (Some c') (dbm_add (M 0 (v c)) (M (v c) (v c')))"
      using dbm_entry_dbm_min2' by fastforce
      with 3 have "-u c'  d + d'" by auto
      thus ?case
      by (metis add_uminus_conv_diff diff_le_eq minus_add_distrib minus_le_iff)
    next
      case (4 d)
      text ‹
        Here is the reason we need the assumption that the zone was not empty before the reset.
        We cannot deduce anything from the current value of c› itself because we reset it.
        We can only ensure that we can reset the value of c› by using the value from the
        alternative assignment.
        This case is only relevant if the tightest bounds for d› were given by its original
        lower and upper bounds. If they would overlap, the original zone would be empty.
      ›
      from A(2,5) have
        "dbm_entry_val u'' None (Some c) (M 0 (v c))"
        "dbm_entry_val u'' (Some c) None (M (v c) 0)"
      unfolding DBM_val_bounded_def by auto
      with 4 have "- u'' c  d" "u'' c  r" by auto
      thus ?case by (metis minus_le_iff order.trans)
    qed
  } note EE = this
  { fix l r assume "l  S_Min_Le" "r  S_Max_Lt"
    then have "l < r"
    proof (auto simp: S_Min_Le S_Max_Lt, goal_cases)
      case (1 c1 d1 c2 d2)
      with A have "dbm_entry_val u (Some c1) (Some c2) (M' (v c1) (v c2))"
      unfolding DBM_val_bounded_def by presburger
      moreover have "M' (v c1) (v c2) = min (dbm_add (M (v c1) (v c)) (M (v c) (v c2))) (M (v c1) (v c2))"
      using A(3,7) 1 unfolding DBM_reset_def by metis
      ultimately have "dbm_entry_val u (Some c1) (Some c2) (dbm_add (M (v c1) (v c)) (M (v c) (v c2)))"
      using dbm_entry_dbm_min' by fastforce
      with 1 have "u c1 - u c2 < d1 + d2" by auto
      then show ?case by (metis add.assoc add.commute diff_less_eq)
    next
      case (2 c' d)
      with A have
        "(in. i  v c  i > 0  M' i 0 = min (dbm_add (M i (v c)) (M (v c) 0)) (M i 0))"
        "v c'  v c"
      unfolding DBM_reset_def by auto
      hence "(M' (v c') 0 = min (dbm_add (M (v c') (v c)) (M (v c) 0)) (M (v c') 0))"
      using 2 by blast
      moreover from A 2 have "dbm_entry_val u (Some c') None (M' (v c') 0)"
      unfolding DBM_val_bounded_def by presburger
      ultimately have "dbm_entry_val u (Some c') None (dbm_add (M (v c') (v c)) (M (v c) 0))"
      using dbm_entry_dbm_min3' by fastforce
      with 2 have "u c' < d + r" by auto
      thus ?case by (metis add_less_imp_less_right diff_add_cancel gt_swap)
    next
      case (3 d c' da)
      with A have
        "(in. i  v c  i > 0  M' 0 i = min (dbm_add (M 0 (v c)) (M (v c) i)) (M 0 i))"
        "v c'  v c"
      unfolding DBM_reset_def by auto
      hence "(M' 0 (v c') = min (dbm_add (M 0 (v c)) (M (v c) (v c'))) (M 0 (v c')))"
      using 3 by blast
      moreover from A 3 have "dbm_entry_val u None (Some c') (M' 0 (v c'))"
      unfolding DBM_val_bounded_def by presburger
      ultimately have "dbm_entry_val u None (Some c') (dbm_add (M 0 (v c)) (M (v c) (v c')))"
      using dbm_entry_dbm_min2' by fastforce
      with 3 have "-u c' < d + da" by auto
      thus ?case by (metis add.commute diff_less_eq uminus_add_conv_diff)
    next
      case (4 d)
      from A(2,5) have
        "dbm_entry_val u'' None (Some c) (M 0 (v c))"
        "dbm_entry_val u'' (Some c) None (M (v c) 0)"
      unfolding DBM_val_bounded_def by auto
      with 4 have "- u'' c  d" "u'' c < r" by auto
      thus ?case by (metis minus_le_iff neq_iff not_le order.strict_trans)
    qed
  } note EL = this
  { fix l r assume "l  S_Min_Lt" "r  S_Max_Le"
    then have "l < r"
    proof (auto simp: S_Min_Lt S_Max_Le, goal_cases)
      case (1 c1 d1 c2 d2)
      with A have "dbm_entry_val u (Some c1) (Some c2) (M' (v c1) (v c2))"
      unfolding DBM_val_bounded_def by presburger
      moreover have "M' (v c1) (v c2) = min (dbm_add (M (v c1) (v c)) (M (v c) (v c2))) (M (v c1) (v c2))"
      using A(3,7) 1 unfolding DBM_reset_def by metis
      ultimately have "dbm_entry_val u (Some c1) (Some c2) (dbm_add (M (v c1) (v c)) (M (v c) (v c2)))"
      using dbm_entry_dbm_min' by fastforce
      with 1 have "u c1 - u c2 < d1 + d2" by auto
      thus ?case by (metis add.assoc add.commute diff_less_eq)
    next
      case (2 c' d)
      with A have
        "(in. i  v c  i > 0  M' i 0 = min (dbm_add (M i (v c)) (M (v c) 0)) (M i 0))"
        "v c'  v c"
      unfolding DBM_reset_def by auto
      hence "(M' (v c') 0 = min (dbm_add (M (v c') (v c)) (M (v c) 0)) (M (v c') 0))"
      using 2 by blast
      moreover from A 2 have "dbm_entry_val u (Some c') None (M' (v c') 0)"
      unfolding DBM_val_bounded_def by presburger
      ultimately have "dbm_entry_val u (Some c') None (dbm_add (M (v c') (v c)) (M (v c) 0))"
      using dbm_entry_dbm_min3' by fastforce
      with 2 have "u c' < d + r" by auto
      thus ?case by (metis add_less_imp_less_right diff_add_cancel gt_swap)
    next
      case (3 d c' da)
      with A have
        "(in. i  v c  i > 0  M' 0 i = min (dbm_add (M 0 (v c)) (M (v c) i)) (M 0 i))"
        "v c'  v c"
      unfolding DBM_reset_def by auto
      hence "(M' 0 (v c') = min (dbm_add (M 0 (v c)) (M (v c) (v c'))) (M 0 (v c')))"
      using 3 by blast
      moreover from A 3 have "dbm_entry_val u None (Some c') (M' 0 (v c'))"
      unfolding DBM_val_bounded_def by presburger
      ultimately have "dbm_entry_val u None (Some c') (dbm_add (M 0 (v c)) (M (v c) (v c')))"
      using dbm_entry_dbm_min2' by fastforce
      with 3 have "-u c' < d + da" by auto
      thus ?case by (metis add.commute diff_less_eq uminus_add_conv_diff)
    next
      case (4 d)
      from A(2,5) have
        "dbm_entry_val u'' None (Some c) (M 0 (v c))"
        "dbm_entry_val u'' (Some c) None (M (v c) 0)"
      unfolding DBM_val_bounded_def by auto
      with 4 have "- u'' c < d" "u'' c  r" by auto
      thus ?case by (meson less_le_trans minus_less_iff)
    qed
  } note LE = this
  { fix l r assume "l  S_Min_Lt" "r  S_Max_Lt"
    then have "l < r"
    proof (auto simp: S_Min_Lt S_Max_Lt, goal_cases)
      case (1 c1 d1 c2 d2)
      with A have "dbm_entry_val u (Some c1) (Some c2) (M' (v c1) (v c2))"
      unfolding DBM_val_bounded_def by presburger
      moreover have "M' (v c1) (v c2) = min (dbm_add (M (v c1) (v c)) (M (v c) (v c2))) (M (v c1) (v c2))"
      using A(3,7) 1 unfolding DBM_reset_def by metis 
      ultimately have "dbm_entry_val u (Some c1) (Some c2) (dbm_add (M (v c1) (v c)) (M (v c) (v c2)))"
      using dbm_entry_dbm_min' by fastforce
      with 1 have "u c1 - u c2 < d1 + d2" by auto
      then show ?case by (metis add.assoc add.commute diff_less_eq)
    next
      case (2 c' d)
      with A have
        "(in. i  v c  i > 0 M' i 0 = min (dbm_add (M i (v c)) (M (v c) 0)) (M i 0))"
        "v c'  v c"
      unfolding DBM_reset_def by auto
      hence "(M' (v c') 0 = min (dbm_add (M (v c') (v c)) (M (v c) 0)) (M (v c') 0))"
      using 2 by blast
      moreover from A 2 have "dbm_entry_val u (Some c') None (M' (v c') 0)"
      unfolding DBM_val_bounded_def by presburger
      ultimately have "dbm_entry_val u (Some c') None (dbm_add (M (v c') (v c)) (M (v c) 0))"
      using dbm_entry_dbm_min3' by fastforce
      with 2 have "u c' < d + r" by auto
      thus ?case by (metis add_less_imp_less_right diff_add_cancel gt_swap)
    next
      case (3 d c' da)
      with A have
        "(in. i  v c  i > 0  M' 0 i = min (dbm_add (M 0 (v c)) (M (v c) i)) (M 0 i))"
        "v c'  v c"
      unfolding DBM_reset_def by auto
      hence "(M' 0 (v c') = min (dbm_add (M 0 (v c)) (M (v c) (v c'))) (M 0 (v c')))"
      using 3 by blast
      moreover from A 3 have "dbm_entry_val u None (Some c') (M' 0 (v c'))"
      unfolding DBM_val_bounded_def by presburger
      ultimately have "dbm_entry_val u None (Some c') (dbm_add (M 0 (v c)) (M (v c) (v c')))"
      using dbm_entry_dbm_min2' by fastforce
      with 3 have "-u c' < d + da" by auto
      thus ?case by (metis ab_group_add_class.ab_diff_conv_add_uminus add.commute diff_less_eq)
    next
      case (4 d)
      from A(2,5) have
        "dbm_entry_val u'' None (Some c) (M 0 (v c))"
        "dbm_entry_val u'' (Some c) None (M (v c) 0)"
      unfolding DBM_val_bounded_def by auto
      with 4 have "- u'' c  d" "u'' c < r" by auto
      thus ?case by (metis minus_le_iff neq_iff not_le order.strict_trans)
    qed
  } note LL = this

  obtain d' where d':
    " t  S_Min_Le. d'  t" " t  S_Min_Lt. d' > t"
    " t  S_Max_Le. d'  t" " t  S_Max_Lt. d' < t"
  proof -
    assume m:
      "d'. tS_Min_Le. t  d'; tS_Min_Lt. t < d'; tS_Max_Le. d'  t; tS_Max_Lt. d' < t
         thesis"
    let ?min_le = "Max S_Min_Le"
    let ?min_lt = "Max S_Min_Lt" 
    let ?max_le = "Min S_Max_Le"
    let ?max_lt = "Min S_Max_Lt"
    
    show thesis
    proof (cases "S_Min_Le = {}  S_Min_Lt = {}")
      case True
      note T = this
      show thesis
      proof (cases "S_Max_Le = {}  S_Max_Lt = {}")
        case True
        let ?d' = "0 :: 't :: time"
        show thesis using True T by (intro m[of ?d']) auto
      next
        case False
        let ?d =
          "if S_Max_Le  {}
           then if S_Max_Lt  {} then min ?max_lt ?max_le else ?max_le
           else ?max_lt"
        obtain a :: "'b" where a: "a < 0" using non_trivial_neg by auto
        let ?d' = "min 0 (?d + a)"
        { fix x assume "x  S_Max_Le"
          with fin_max_le a have "min 0 (Min S_Max_Le + a)  x"
          by (metis Min.boundedE add_le_same_cancel1 empty_iff less_imp_le min.coboundedI2)
          then have "min 0 (Min S_Max_Le + a)  x" by auto
        } note 1 = this
        { fix x assume x: "x  S_Max_Lt"
          have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a) < ?max_lt"
          by (meson a add_less_same_cancel1 min.cobounded1 min.strict_coboundedI2 order.strict_trans2) 
          also from fin_max_lt x have "  x" by auto
          finally have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a) < x" .
        } note 2 = this
        { fix x assume x: "x  S_Max_Le"
          have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a)  ?max_le"
          by (metis le_add_same_cancel1 linear not_le a min_le_iff_disj)
          also from fin_max_le x have "  x" by auto
          finally have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a)  x" .
        } note 3 = this
        show thesis using False T a 1 2 3
        proof ((intro m[of ?d']), auto, goal_cases)
          case 1 then show ?case
          by (metis Min.in_idem add.commute fin_max_lt leD le_add_same_cancel2 min.orderI
                    min_less_iff_disj not_less_iff_gr_or_eq)
        qed
      qed
    next
      case False
      note F = this
      show thesis
      proof (cases "S_Max_Le = {}  S_Max_Lt = {}")
        case True
        let ?l =
          "if S_Min_Le  {}
           then if S_Min_Lt  {} then max ?min_lt ?min_le else ?min_le
           else ?min_lt"
        obtain a :: "'b" where "a < 0" using non_trivial_neg by blast
        then have a: "-a > 0" using non_trivial_neg by simp
        then obtain a :: "'b" where a: "a > 0" by blast
        let ?d' = "?l + a"
        {
          fix x assume x: "x  S_Min_Le"
          then have "x  max ?min_lt ?min_le" "x  ?min_le" using fin_min_le by (simp add: max.coboundedI2)+
          then have "x  max ?min_lt ?min_le + a" "x  ?min_le + a" using a by (simp add: add_increasing2)+
        } note 1 = this
        {
          fix x assume x: "x  S_Min_Lt"
          then have "x  max ?min_lt ?min_le" "x  ?min_lt" using fin_min_lt by (simp add: max.coboundedI1)+
          then have "x < ?d'" using a x by (auto simp add: add.commute add_strict_increasing)
        } note 2 = this
        show thesis using True F a 1 2 by ((intro m[of ?d']), auto)
      next
        case False
        let ?r =
          "if S_Max_Le  {}
           then if S_Max_Lt  {} then min ?max_lt ?max_le else ?max_le
           else ?max_lt"
        let ?l =
          "if S_Min_Le  {}
           then if S_Min_Lt  {} then max ?min_lt ?min_le else ?min_le
           else ?min_lt"
        have 1: "x  max ?min_lt ?min_le" "x  ?min_le" if "x  S_Min_Le" for x
        by (simp add: max.coboundedI2 that fin_min_le)+
        {
          fix x y assume x: "x  S_Max_Le" "y  S_Min_Lt"
          then have "S_Min_Lt  {}" by auto
          from LE[OF Max_in[OF fin_min_lt], OF this, OF x(1)] have "?min_lt  x" by auto
        } note 3 = this
        {
          fix x y assume x: "x  S_Max_Le" "y  S_Min_Le"
          with EE[OF Max_in[OF fin_min_le], OF _ x(1)] have "?min_le  x" by auto
        } note 4 = this
        {
          fix x y assume x: "x  S_Max_Lt" "y  S_Min_Lt"
          then have "S_Min_Lt  {}" by auto
          from LL[OF Max_in[OF fin_min_lt], OF this, OF x(1)] have "?min_lt < x" by auto
        } note 5 = this
        {
          fix x y assume x: "x  S_Max_Lt" "y  S_Min_Le"
          then have "S_Min_Le  {}" by auto
          from EL[OF Max_in[OF fin_min_le], OF this, OF x(1)] have "?min_le < x" by auto
        } note 6 = this
        
        show thesis
        proof (cases "?l < ?r")
          case False
          then have *: "S_Max_Le  {}"
          proof (auto, goal_cases)
            case 1
            with ¬ (S_Max_Le = {}  S_Max_Lt = {}) obtain y where y:"y  S_Max_Lt" by auto
            note 1 = 1 this
            { fix x y assume A: "x  S_Min_Le" "y  S_Max_Lt"
                  with EL[OF Max_in[OF fin_min_le] Min_in[OF fin_max_lt]]
                  have "Max S_Min_Le < Min S_Max_Lt" by auto
            } note ** = this
            { fix x y assume A: "x  S_Min_Lt" "y  S_Max_Lt"
                with LL[OF Max_in[OF fin_min_lt] Min_in[OF fin_max_lt]]
                have "Max S_Min_Lt < Min S_Max_Lt" by auto
            } note *** = this
            show ?case
            proof (cases "S_Min_Le  {}")
              case True
              note T = this
              show ?thesis
              proof (cases "S_Min_Lt  {}")
                case True
                then show False using 1 T True ** *** by auto
              next
                case False with 1 T ** show False by auto
              qed
            next
              case False
              with 1 False *** ¬ (S_Min_Le = {}  S_Min_Lt = {}) show ?thesis by auto
            qed
          qed
          { fix x y assume A: "x  S_Min_Lt" "y  S_Max_Lt"
                with LL[OF Max_in[OF fin_min_lt] Min_in[OF fin_max_lt]]
                have "Max S_Min_Lt < Min S_Max_Lt" by auto
            } note *** = this
          { fix x y assume A: "x  S_Min_Lt" "y  S_Max_Le"
                  with LE[OF Max_in[OF fin_min_lt] Min_in[OF fin_max_le]]
                  have "Max S_Min_Lt < Min S_Max_Le" by auto
          } note **** = this
          from F False have **: "S_Min_Le  {}"
          proof (auto, goal_cases)
            case 1
            show ?case
            proof (cases "S_Max_Le  {}")
              case True
              note T = this
              show ?thesis
              proof (cases "S_Max_Lt  {}")
                case True
                then show False using 1 T True **** *** by auto
              next
                case False with 1 T **** show False by auto
              qed
            next
              case False
              with 1 False *** ¬ (S_Max_Le = {}  S_Max_Lt = {}) show ?thesis by auto
            qed
          qed
          {
            fix x assume x: "x  S_Min_Lt"
            then have "x  ?min_lt" using fin_min_lt by (simp add: max.coboundedI2)
            also have "?min_lt < ?min_le"
            proof (rule ccontr, goal_cases)
              case 1
              with x ** have 1: "?l = ?min_lt" by (auto simp: max.absorb1)
              have 2: "?min_lt < ?max_le" using * ****[OF x] by auto
              show False
              proof (cases "S_Max_Lt = {}")
                case False
                then have "?min_lt < ?max_lt" using * ***[OF x] by auto
                with 1 2 have "?l < ?r" by auto
                with ¬ ?l < ?r show False by auto
              next
                case True
                with 1 2 have "?l < ?r" by auto
                with ¬ ?l < ?r show False by auto
              qed
            qed
            finally have "x < max ?min_lt ?min_le" by (simp add: max.strict_coboundedI2) 
          } note 2 = this
          show thesis using F False 1 2 3 4 5 6 * ** by ((intro m[of ?l]), auto)
        next
          case True
          then obtain d where d: "?l < d" "d < ?r" using dense by auto
          let ?d' = "d"
          {
            fix t assume "t  S_Min_Le"
            then have "t  ?l" using 1 by auto
            with d have "t  d" by auto
          }
          moreover {
            fix t assume t: "t  S_Min_Lt"
            then have "t  max ?min_lt ?min_le" using fin_min_lt by (simp add: max.coboundedI1)
            with t have "t  ?l" using fin_min_lt by auto
            with d have "t < d" by auto
          }
          moreover {
            fix t assume t: "t  S_Max_Le"
            then have "min ?max_lt ?max_le  t" using fin_max_le by (simp add: min.coboundedI2)
            then have "?r  t" using fin_max_le t by auto
            with d have "d  t" by auto
            then have "d  t" by (simp add: min.coboundedI2)
          }
          moreover {
            fix t assume t: "t  S_Max_Lt"
            then have "min ?max_lt ?max_le  t" using fin_max_lt by (simp add: min.coboundedI1)
            then have "?r  t" using fin_max_lt t by auto
            with d have "d < t" by auto
            then have "d < t" by (simp add: min.strict_coboundedI2)
          }
          ultimately show thesis by ((intro m[of ?d']), auto)
        qed
      qed
    qed
  qed
  have "DBM_val_bounded v (u(c := d')) M n" unfolding DBM_val_bounded_def
  proof (auto, goal_cases)
    case 1
    with A show ?case unfolding DBM_reset_def DBM_val_bounded_def by auto
  next
    case (2 c')
    show ?case
    proof (cases "c = c'")
      case False
      with A(2,7) have "v c  v c'" by auto
      hence *:"M' 0 (v c') = min (dbm_add (M 0 (v c)) (M (v c) (v c'))) (M 0 (v c'))"
      using A(2,3,6,7) 2 unfolding DBM_reset_def by auto
      from 2 A(2,4) have "dbm_entry_val u None (Some c') (M' 0 (v c'))"
      unfolding DBM_val_bounded_def by auto
      with dbm_entry_dbm_min2 * have "dbm_entry_val u None (Some c') (M 0 (v c'))" by auto
      thus ?thesis using False by cases auto
    next
      case True
      show ?thesis
      proof (simp add: True[symmetric], cases "M 0 (v c)", goal_cases)
        case (1 t)
        hence "-t  S_Min_Le" unfolding S_Min_Le by force
        hence "d'  -t" using d' by auto
        thus ?case using 1 by (auto simp: minus_le_iff)
      next
        case (2 t)
        hence "-t  S_Min_Lt" unfolding S_Min_Lt by force
        hence "d' > -t" using d' by auto
        thus ?case using 2 by (auto simp: minus_less_iff)
      next
        case 3 thus ?case by auto
      qed
    qed
  next
    case (3 c')
    show ?case
    proof (cases "c = c'")
      case False
      with A(2,7) have "v c  v c'" by auto
      hence *:"M' (v c') 0 = min (dbm_add (M (v c') (v c)) (M (v c) 0)) (M (v c') 0)"
      using A(2,3,6,7) 3 unfolding DBM_reset_def by auto
      from 3 A(2,4) have "dbm_entry_val u (Some c') None (M' (v c') 0)"
      unfolding DBM_val_bounded_def by auto
      with dbm_entry_dbm_min3 * have "dbm_entry_val u (Some c') None (M (v c') 0)" by auto
      thus ?thesis using False by cases auto
    next
      case True
      show ?thesis
      proof (simp add: True[symmetric], cases "M (v c) 0", goal_cases)
        case (1 t)
        hence "t  S_Max_Le" unfolding S_Max_Le by force
        hence "d'  t" using d' by auto
        thus ?case using 1 by (auto simp: minus_le_iff)
      next
        case (2 t)
        hence "t  S_Max_Lt" unfolding S_Max_Lt by force
        hence "d' < t" using d' by auto
        thus ?case using 2 by (auto simp: minus_less_iff)
      next
        case 3 thus ?case by auto
      qed
    qed
  next
    case (4 c1 c2)
    show ?case
    proof (cases "c = c1")
      case False
      note F1 = this
      show ?thesis
      proof (cases "c = c2")
        case False
        with A(2,6,7) F1 have "v c  v c1" "v c  v c2" by auto
        hence *:"M' (v c1) (v c2) = min (dbm_add (M (v c1) (v c)) (M (v c) (v c2))) (M (v c1) (v c2))"
        using A(2,3,6,7) 4 unfolding DBM_reset_def by auto
        from 4 A(2,4) have "dbm_entry_val u (Some c1) (Some c2) (M' (v c1) (v c2))"
        unfolding DBM_val_bounded_def by auto
        with dbm_entry_dbm_min * have "dbm_entry_val u (Some c1) (Some c2) (M (v c1) (v c2))" by auto
        thus ?thesis using F1 False by cases auto
      next
        case True
        show ?thesis
        proof (simp add: True[symmetric], cases "M (v c1) (v c)", goal_cases)
          case (1 t)
          hence "u c1 - t  S_Min_Le" unfolding S_Min_Le using A F1 4 by blast
          hence "d'  u c1 - t" using d' by auto
          hence "t + d'  u c1" by (metis le_swap add_le_cancel_right diff_add_cancel) 
          hence "u c1 - d'  t" by (metis add_le_imp_le_right diff_add_cancel) 
          thus ?case using 1 F1 by auto
        next
          case (2 t)
          hence "u c1 - t  S_Min_Lt" unfolding S_Min_Lt using A 4 F1 by blast
          hence "d' > u c1 - t" using d' by auto
          hence "d' + t > u c1" by (metis add_strict_right_mono diff_add_cancel)
          hence "u c1 - d' < t" by (metis gt_swap add_less_cancel_right diff_add_cancel)
          thus ?case using 2 F1 by auto
        next
          case 3 thus ?case by auto
        qed
      qed
    next
      case True
      note T = this
      show ?thesis
      proof (cases "c = c2")
        case False
        show ?thesis
        proof (cases "M (v c) (v c2)", goal_cases)
          case (1 t)
          hence "u c2 + t  S_Max_Le" unfolding S_Max_Le using A 4 False by blast
          hence "d'  u c2 + t" using d' by auto
          hence "d' - u c2  t"
          by (metis (hide_lams, no_types) add_diff_cancel_left add_ac(1) add_le_cancel_right
              add_right_cancel diff_add_cancel)
          thus ?case using 1 T False by auto
        next
          case (2 t)
          hence "u c2 + t  S_Max_Lt" unfolding S_Max_Lt using A 4 False by blast
          hence "d' < u c2 + t" using d' by auto
          hence "d' - u c2 < t" by (metis gt_swap add_less_cancel_right diff_add_cancel)
          thus ?case using 2 T False by force
        next
          case 3 thus ?case using T by auto
        qed
      next
        case True
        from A 4 have *:"dbm_entry_val u'' (Some c1) (Some c1) (M (v c1) (v c1))"
        unfolding DBM_val_bounded_def by auto
        show ?thesis using True T
        proof (simp add: True T, cases "M (v c1) (v c1)", goal_cases)
          case (1 t)
          with * have "0  t" by auto
          thus ?case using 1 by auto
        next
          case (2 t)
          with * have "0 < t" by auto
          thus ?case using 2 by auto
        next
          case 3 thus ?case by auto
        qed
      qed
    qed
  qed
  thus ?thesis using A(1) by blast
qed

lemma DBM_reset_sound2:
  assumes "v c  n" "DBM_reset M n (v c) d M'" "DBM_val_bounded v u M' n"
  shows "u c = d"
using assms unfolding DBM_val_bounded_def DBM_reset_def
by fastforce

lemma DBM_reset_sound'':
  fixes M v c n d
  defines "M'  reset M n (v c) d"
  assumes "clock_numbering' v n" "v c  n" "DBM_val_bounded v u M' n"
          "DBM_val_bounded v u'' M n"
  obtains d' where  "DBM_val_bounded v (u(c := d')) M n"
proof -
  assume A:"d'. DBM_val_bounded v (u(c := d')) M n  thesis"
  from assms DBM_reset_reset[of "v c" n M d]
  have *:"DBM_reset M n (v c) d M'" by (auto simp add: M'_def)
  with DBM_reset_sound'[of v n c M d M', OF _ _ this] assms obtain d' where
  "DBM_val_bounded v (u(c := d')) M n" by auto
  with A show thesis by auto
qed

lemma DBM_reset_sound:
  fixes M v c n d
  defines "M'  reset M n (v c) d"
  assumes "kn. k > 0  (c. v c = k)" "clock_numbering' v n" "v c  n"
          "u  [M']v,n"
  obtains d' where  "u(c := d') [M]v,n"
proof (cases "[M]v,n = {}")
  case False
  then obtain u' where "DBM_val_bounded v u' M n" unfolding DBM_zone_repr_def by auto
  from DBM_reset_sound''[OF assms(3-4) _ this] assms(1,5) that show ?thesis
  unfolding DBM_zone_repr_def by auto
next
  case True
  with DBM_reset_complete_empty'[OF assms(2) _ _ DBM_reset_reset, of "v c" M u d] assms show ?thesis
  unfolding DBM_zone_repr_def by simp
qed

lemma DBM_reset'_complete':
  assumes "DBM_val_bounded v u M n" "clock_numbering' v n" " c  set cs. v c  n"
  shows " u'. DBM_val_bounded v u' (reset' M n cs v d) n"
using assms
proof (induction cs)
  case Nil thus ?case by auto
next
  case (Cons c cs)
  let ?M' = "reset' M n cs v d"
  let ?M'' = "reset ?M' n (v c) d"
  from Cons obtain u' where u': "DBM_val_bounded v u' ?M' n" by fastforce
  from Cons(3,4) have "0 < v c" "v c  n" by auto
  from DBM_reset_reset[OF this] have **: "DBM_reset ?M' n (v c) d ?M''" by fast
  from Cons(4) have "v c  n" by auto
  from DBM_reset_complete[of v n c ?M' d ?M'', OF Cons(3) this ** u']
  have "DBM_val_bounded v (u'(c := d)) (reset (reset' M n cs v d) n (v c) d) n" by fast
  thus ?case by auto
qed

lemma DBM_reset'_complete:
  assumes "DBM_val_bounded v u M n" "clock_numbering' v n" " c  set cs. v c  n"
  shows "DBM_val_bounded v ([cs  d]u) (reset' M n cs v d) n"
using assms
proof (induction cs)
  case Nil thus ?case by auto
next
  case (Cons c cs)
  let ?M' = "reset' M n cs v d"
  let ?M'' = "reset ?M' n (v c) d"
  from Cons have *: "DBM_val_bounded v ([csd]u) (reset' M n cs v d) n" by fastforce
  from Cons(3,4) have "0 < v c" "v c  n" by auto
  from DBM_reset_reset[OF this] have **: "DBM_reset ?M' n (v c) d ?M''" by fast
  from Cons(4) have "v c  n" by auto
  from DBM_reset_complete[of v n c ?M' d ?M'', OF Cons(3) this ** *]
  have ***:"DBM_val_bounded v ([c#csd]u) (reset (reset' M n cs v d) n (v c) d) n" by simp
  have "reset' M n (c#cs) v d = reset (reset' M n cs v d) n (v c) d" by auto
  with *** show ?case by presburger
qed

lemma DBM_reset'_sound_empty:
  assumes "clock_numbering' v n" "c  set cs. v c  n"
          " u . ¬ DBM_val_bounded v u (reset' M n cs v d) n"
  shows "¬ DBM_val_bounded v u M n"
using assms DBM_reset'_complete by metis

fun set_clocks :: "'c list  't::time list ('c,'t) cval  ('c,'t) cval"
where
  "set_clocks [] _ u = u" |
  "set_clocks _ [] u = u" |
  "set_clocks (c#cs) (t#ts) u = (set_clocks cs ts (u(c:=t)))"

lemma DBM_reset'_sound':
  fixes M v c n d cs
  assumes "clock_numbering' v n" " c  set cs. v c  n"
          "DBM_val_bounded v u (reset' M n cs v d) n" "DBM_val_bounded v u'' M n"
  shows "ts. DBM_val_bounded v (set_clocks cs ts u) M n"
using assms
proof (induction cs arbitrary: M u)
  case Nil
  hence "DBM_val_bounded v (set_clocks [] [] u) M n" by auto
  thus ?case by blast
next
  case (Cons c' cs)
  let ?M' = "reset' M n (c' # cs) v d"
  let ?M'' = "reset' M n cs v d"
  from DBM_reset'_complete[OF Cons(5) Cons(2)] Cons(3)
  have u'': "DBM_val_bounded v ([csd]u'') ?M'' n" by fastforce
  from Cons(3,4) have "v c'  n" "DBM_val_bounded v u (reset ?M'' n (v c') d) n" by auto
  from DBM_reset_sound''[OF Cons(2) this u'']
  obtain d' where **:"DBM_val_bounded v (u(c' := d')) ?M'' n" by blast
  from Cons.IH[OF Cons.prems(1) _ ** Cons.prems(4)] Cons.prems(2)
  obtain ts where ts:"DBM_val_bounded v (set_clocks cs ts (u(c' := d'))) M n" by fastforce
  hence "DBM_val_bounded v (set_clocks (c' # cs) (d'#ts) u) M n" by auto
  thus ?case by fast
qed

lemma DBM_reset'_resets:
  fixes M v c n d cs
  assumes "kn. k > 0  (c. v c = k)" "clock_numbering' v n" " c  set cs. v c  n"
          "DBM_val_bounded v u (reset' M n cs v d) n"
  shows "c  set cs. u c = d"
using assms
proof (induction cs arbitrary: M u)
  case Nil thus ?case by auto
next
  case (Cons c' cs)
  let ?M' = "reset' M n (c' # cs) v d"
  let ?M'' = "reset' M n cs v d"
  from Cons(4,5) have "v c'  n" "DBM_val_bounded v u (reset ?M'' n (v c') d) n" by auto
  from DBM_reset_sound2[OF this(1) _ Cons(5), of ?M'' d] DBM_reset_reset[OF _ this(1), of ?M'' d] Cons(3)
  have c':"u c' = d" by auto
  from Cons(4,5) have "v c'  n" "DBM_val_bounded v u (reset ?M'' n (v c') d) n" by auto
  with DBM_reset_sound[OF Cons.prems(1,2) this(1)]
  obtain d' where **:"DBM_val_bounded v (u(c' := d')) ?M'' n" unfolding DBM_zone_repr_def by blast
  from Cons.IH[OF Cons.prems(1,2) _ **] Cons.prems(3) have "cset cs. (u(c' := d')) c = d" by auto
  thus ?case using c'
   apply safe
   apply (rename_tac c)
   apply (case_tac "c = c'")
  by auto
qed

lemma DBM_reset'_resets':
  fixes M v c n d cs
  assumes "clock_numbering' v n" " c  set cs. v c  n" "DBM_val_bounded v u (reset' M n cs v d) n"
          "DBM_val_bounded v u'' M n"
  shows "c  set cs. u c = d"
using assms
proof (induction cs arbitrary: M u)
  case Nil thus ?case by auto
next
  case (Cons c' cs)
  let ?M' = "reset' M n (c' # cs) v d"
  let ?M'' = "reset' M n cs v d"
  from DBM_reset'_complete[OF Cons(5) Cons(2)] Cons(3)
  have u'': "DBM_val_bounded v ([csd]u'') ?M'' n" by fastforce
  from Cons(3,4) have "v c'  n" "DBM_val_bounded v u (reset ?M'' n (v c') d) n" by auto
  from DBM_reset_sound2[OF this(1) _ Cons(4), of ?M'' d] DBM_reset_reset[OF _ this(1), of ?M'' d] Cons(2)
  have c':"u c' = d" by auto
  from Cons(3,4) have "v c'  n" "DBM_val_bounded v u (reset ?M'' n (v c') d) n" by auto
  from DBM_reset_sound''[OF Cons(2) this u'']
  obtain d' where **:"DBM_val_bounded v (u(c' := d')) ?M'' n" by blast
  from Cons.IH[OF Cons.prems(1) _ ** Cons.prems(4)] Cons.prems(2)
  have "cset cs. (u(c' := d')) c = d" by auto
  thus ?case using c'
   apply safe
   apply (rename_tac c)
   apply (case_tac "c = c'")
  by auto
qed

lemma DBM_reset'_neg_diag_preservation':
  assumes "kn" "M k k < 𝟭" "clock_numbering v" " c  set cs. v c  n"
  shows "reset' M n cs v d k k < 𝟭" using assms
proof (induction cs)
  case Nil thus ?case by auto
next
  case (Cons c cs)
  then have IH: "reset' M n cs v d k k < 𝟭" by auto
  from Cons.prems have "v c > 0" "v c  n" by auto
  from DBM_reset_reset[OF this, of "reset' M n cs v d" d] k  n
  have "reset (reset' M n cs v d) n (v c) d k k  reset' M n cs v d k k" unfolding DBM_reset_def
  by (cases "v c = k", simp add: less[symmetric], case_tac "k = 0", auto simp: less[symmetric])
  with IH show ?case by auto
qed

lemma DBM_reset'_complete_empty':
  assumes "kn. k > 0  (c. v c = k)" "clock_numbering' v n"
          " c  set cs. v c  n" " u . ¬ DBM_val_bounded v u M n"
  shows " u . ¬ DBM_val_bounded v u (reset' M n cs v d) n" using assms
proof (induction cs)
  case Nil then show ?case by simp
next
  case (Cons c cs)
  then have "u. ¬ DBM_val_bounded v u (reset' M n cs v d) n" by auto
  from Cons.prems(2,3) DBM_reset_complete_empty'[OF Cons.prems(1) _ _ DBM_reset_reset this] 
  show ?case by auto
qed

lemma DBM_reset'_complete_empty:
  assumes "kn. k > 0  (c. v c = k)" "clock_numbering' v n"
          " c  set cs. v c  n" " u . ¬ DBM_val_bounded v u M n"
  shows " u . ¬ DBM_val_bounded v u (reset' (FW M n) n cs v d) n" using assms
proof -
  note A = assms
  from A(4) have "[M]v,n = {}" unfolding DBM_zone_repr_def by auto
  with FW_zone_equiv[OF A(1)] have "[FW M n]v,n = {}" by auto
  with FW_detects_empty_zone[OF A(1)] A(2) obtain i where i: "i  n" "FW M n i i < Le 0" by blast
  with DBM_reset'_neg_diag_preservation' A(2,3) have
    "reset' (FW M n) n cs v d i i < Le 0"
  by (auto simp: neutral)
  with fw_mono[of n n n i i "reset' (FW M n) n cs v d" n] i
  have "FW (reset' (FW M n) n cs v d) n i i < Le 0" by auto
  with FW_detects_empty_zone[OF A(1), of "reset' (FW M n) n cs v d"] A(2,3) i
  have "[FW (reset' (FW M n) n cs v d) n]v,n = {}" by auto
  with FW_zone_equiv[OF A(1), of "reset' (FW M n) n cs v d"] A(3,4)
  show ?thesis by (auto simp: DBM_zone_repr_def)
qed

lemma DBM_reset'_empty':
  assumes "kn. k > 0  (c. v c = k)" "clock_numbering' v n" " c  set cs. v c  n"
  shows "[M]v,n = {}  [reset' (FW M n) n cs v d]v,n = {}"
proof
  let ?M' = "reset' (FW M n) n cs v d"
  assume A: "[M]v,n = {}"
  hence " u . ¬ DBM_val_bounded v u M n" unfolding DBM_zone_repr_def by auto
  with DBM_reset'_complete_empty[OF assms] show "[?M']v,n = {}" unfolding DBM_zone_repr_def by auto
next
  let ?M' = "reset' (FW M n) n cs v d"
  assume A: "[?M']v,n = {}"
  hence " u . ¬ DBM_val_bounded v u ?M' n" unfolding DBM_zone_repr_def by auto
  from DBM_reset'_sound_empty[OF assms(2,3) this] have " u. ¬ DBM_val_bounded v u (FW M n) n" by auto
  with FW_zone_equiv[OF assms(1)] show "[M]v,n = {}" unfolding DBM_zone_repr_def by auto
qed

lemma DBM_reset'_empty:
  assumes "kn. k > 0  (c. v c = k)" "clock_numbering' v n" " c  set cs. v c  n"
  shows "[M]v,n = {}  [reset' M n cs v d]v,n = {}"
proof
  let ?M' = "reset' M n cs v d"
  assume A: "[M]v,n = {}"
  hence " u . ¬ DBM_val_bounded v u M n" unfolding DBM_zone_repr_def by auto
  with DBM_reset'_complete_empty'[OF assms] show "[?M']v,n = {}" unfolding DBM_zone_repr_def by auto
next
  let ?M' = "reset' M n cs v d"
  assume A: "[?M']v,n = {}"
  hence " u . ¬ DBM_val_bounded v u ?M' n" unfolding DBM_zone_repr_def by auto
  from DBM_reset'_sound_empty[OF assms(2,3) this] have " u. ¬ DBM_val_bounded v u M n" by auto
  with FW_zone_equiv[OF assms(1)] show "[M]v,n = {}" unfolding DBM_zone_repr_def by auto
qed

lemma DBM_reset'_sound:
  assumes "kn. k > 0  (c. v c = k)" "clock_numbering' v n"
    and "cset cs. v c  n"
    and "u  [reset' M n cs v d]v,n"
  shows "ts. set_clocks cs ts u  [M]v,n"
proof -
  from DBM_reset'_empty[OF assms(1-3)] assms(4) obtain u' where "u'  [M]v,n" by blast
  with DBM_reset'_sound'[OF assms(2,3)] assms(4) show ?thesis unfolding DBM_zone_repr_def by blast
qed

section ‹Misc Preservation Lemmas›

lemma get_const_sum[simp]:
  "a    b    get_const a    get_const b    get_const (a + b)  "
by (cases a) (cases b, auto simp: mult)+

lemma sum_not_inf_dest:
  assumes "a + b  "
  shows "a    b  "
using assms by (cases a; cases b; simp add: mult)

lemma sum_not_inf_int:
  assumes "a + b  " "get_const a  " "get_const b  "
  shows "get_const (a + b)  "
using assms sum_not_inf_dest by fastforce

lemma int_fw_upd:
  " i  n.  j  n. m i j    get_const (m i j)    k  n  i  n  j  n
   i'  n  j'  n  (fw_upd m k i j i' j')  
   get_const (fw_upd m k i j i' j')  "
proof (goal_cases)
  case 1
  show ?thesis
  proof (cases "i = i'  j = j'")
    case True
    with 1 show ?thesis by (fastforce simp: fw_upd_def upd_def min_def dest: sum_not_inf_dest)
  next
    case False
    with 1 show ?thesis by (auto simp : fw_upd_def upd_def)
  qed
qed

lemma fw_int_aux_c:
  assumes " i  n.  j  n. M i j    get_const (M i j)  " "a  n" "b  n" "c  n"
          "i  n" "j  n" "((fw M n) 0 0 c) i j  "
  shows "get_const (((fw M n) 0 0 c) i j)  "
using assms
 apply (induction c arbitrary: i j)
  apply (auto simp: fw_upd_def upd_def min_def)[]
  apply (case_tac "M 0 0 = ")
   apply (simp add: mult)
  apply simp
 apply (fastforce simp: min_def fw_upd_def upd_def dest: sum_not_inf_dest)
done

lemma fw_int_aux_Suc_b:
  assumes " i  n.  j  n. (fw M n) a b n i j    get_const ((fw M n) a b n i j)  "
          "a  n" "Suc b  n" "c  n" "i  n" "j  n" "((fw M n) a (Suc b) c) i j  "
  shows "get_const (((fw M n) a (Suc b) c) i j)  "
using assms by (induction c arbitrary: i j) (auto intro: int_fw_upd[of n])

lemma fw_int_aux_b:
  assumes " i  n.  j  n. M i j    get_const (M i j)  " "a  n" "b  n" "c  n"
          "i  n" "j  n" "((fw M n) 0 b c) i j  "
  shows "get_const (((fw M n) 0 b c) i j)  " using assms
 apply (induction b arbitrary: i j c)
  apply (blast intro: fw_int_aux_c)
 apply (rule fw_int_aux_Suc_b[of n])
by auto

lemma fw_int_aux_Suc_a:
  assumes " i  n.  j  n. (fw M n) a n n i j    get_const ((fw M n) a n n i j)  "
          "Suc a  n" "b  n" "c  n" "i  n" "j  n" "((fw M n) (Suc a) b c) i j  "
  shows "get_const (((fw M n) (Suc a) b c) i j)  "
using assms
proof (induction b arbitrary: i j c)
  case 0
  then show ?case
  by (induction c arbitrary: i j) (auto intro: int_fw_upd[of n])
next
  case (Suc b)
  then show ?case by (intro fw_int_aux_Suc_b) auto
qed

lemma fw_int_preservation:
  assumes " i  n.  j  n. M i j    get_const (M i j)  " "a  n" "b  n" "c  n"
          "i  n" "j  n" "((fw M n) a b c) i j  "
  shows "get_const (((fw M n) a b c) i j)  "
using assms
 apply (induction a arbitrary: i j b c)
  apply (blast intro: fw_int_aux_b)
 apply (rule fw_int_aux_Suc_a[of n])
by auto

lemma FW_int_preservation:
  assumes " i  n.  j  n. M i j    get_const (M i j)  "
  shows " i  n.  j  n. FW M n i j    get_const (FW M n i j)  "
by (blast intro: fw_int_preservation[OF assms(1)])

abbreviation "dbm_int M n   in.  jn. M i j    get_const (M i j)  "

lemma And_int_preservation:
  assumes "dbm_int M1 n" "dbm_int M2 n"
  shows "dbm_int (And M1 M2) n"
using assms by (auto simp: min_def)

lemma up_int_preservation:
  "dbm_int M n  dbm_int (up M) n"
unfolding up_def min_def
 apply safe
 apply (case_tac "i = 0")
  apply fastforce
 apply (case_tac "j = 0")
  apply fastforce
 apply auto
unfolding mult[symmetric] by (auto dest: sum_not_inf_dest)

(* Definitely a candidate for cleaning *)
lemma DBM_reset_int_preservation':
  assumes "dbm_int M n" "DBM_reset M n k d M'" "d  " "k  n"
  shows "dbm_int M' n"
proof clarify
  fix i j
  assume A: "i  n" "j  n" "M' i j  "
  from assms(2) show "get_const (M' i j)  " unfolding DBM_reset_def
    apply (cases "i = k"; cases "j = k")
      apply simp
      using A assms(1,4) apply presburger
     apply (cases "j = 0")
      using assms(3) apply simp
     using A apply simp
    apply simp
    apply (cases "i = 0")
      using assms(3) apply simp
     using A apply simp
    using A apply simp
    apply (simp split: split_min, safe)
    subgoal
    proof goal_cases
      case 1
      then have *: "M i k + M k j  " unfolding mult min_def by meson
      with sum_not_inf_dest have "M i k  " "M k j  " by auto
      with 1(3,4) assms(1,4) have "get_const (M i k)  " "get_const (M k j)  " by auto
      with sum_not_inf_int[folded mult, OF *] show ?case unfolding mult by auto
    qed
    subgoal
    proof goal_cases
      case 1
      then have *: "M i j  " unfolding mult min_def by meson
      with 1(3,4) assms(1,4) show ?case by auto
    qed
  done
qed

lemma DBM_reset_int_preservation:
  assumes "dbm_int M n" "d  " "0 < k" "k  n"
  shows "dbm_int (reset M n k d) n"
using assms(3-) DBM_reset_int_preservation'[OF assms(1) DBM_reset_reset assms(2)] by blast

lemma DBM_reset'_int_preservation:
  assumes "dbm_int M n" "d  " "c. v c > 0" " c  set cs. v c  n"
  shows "dbm_int (reset' M n cs v d) n" using assms
proof (induction cs)
  case Nil then show ?case by simp
next
  case (Cons c cs)
  from Cons.IH[OF Cons.prems(1,2,3)] Cons.prems(4) have "dbm_int (reset' M n cs v d) n" by fastforce
  from DBM_reset_int_preservation[OF this Cons.prems(2), of "v c"] Cons.prems(3,4) show ?case by auto
qed

lemma int_zone_dbm:
  assumes "clock_numbering' v n"
    " (_,d)  collect_clock_pairs cc. d  " " c  collect_clks cc. v c  n"
  obtains M where "{u. u  cc} = [M]v,n"
            and   " i  n.  j  n. M i j    get_const (M i j)  "
proof -
  let ?M = "abstr cc (λi j. ) v"
  from assms(2) have " i  n.  j  n. ?M i j    get_const (?M i j)  "
  by (induction cc) (auto simp: min_def)
  with dbm_abstr_zone_eq[OF assms(1) assms(3)] show ?thesis by (auto intro: that)
qed

lemma reset_set1:
  "c  set cs. ([csd]u) c = d"
by (induction cs) auto

lemma reset_set11:
  "c. c  set cs  ([csd]u) c = u c"
by (induction cs) auto

lemma reset_set2:
  "c. c  set cs  (set_clocks cs ts u)c = u c"
proof (induction cs arbitrary: ts u)
  case Nil then show ?case by auto
next
  case Cons then show ?case
  proof (cases ts, goal_cases)
   case Nil then show ?thesis by simp
  next
    case (2 a') then show ?case by auto
  qed
qed

lemma reset_set:
  assumes " c  set cs. u c = d"
  shows "[csd](set_clocks cs ts u) = u"
proof
  fix c
  show "([csd]set_clocks cs ts u) c = u c"
  proof (cases "c  set cs")
    case True
    hence "([csd]set_clocks cs ts u) c = d" using reset_set1 by fast
    also have "d = u c" using assms True by auto
    finally show ?thesis by auto
  next
    case False
    hence "([csd]set_clocks cs ts u) c = set_clocks cs ts u c" by (simp add: reset_set11)
    also  with False have " = u c" by (simp add: reset_set2)
    finally show ?thesis by auto
  qed
qed

abbreviation global_clock_numbering ::
  "('a, 'c, 't :: time, 's) ta  ('c  nat)  nat  bool"
where
  "global_clock_numbering A v n 
    clock_numbering' v n  ( c  clk_set A. v c  n)  (kn. k > 0  (c. v c = k))"

lemma dbm_int_abstr:
  assumes " (x, m)  collect_clock_pairs g. m  "
  shows "dbm_int (abstr g (λi j. ) v) n"
using assms
  apply (induction g)
       apply auto[]
unfolding min_def by auto

lemma dbm_int_inv_abstr:
  assumes "(x,m)  clkp_set A. m  "
  shows "dbm_int (abstr (inv_of A l) (λi j. ) v) n"
proof -
  from assms have " (x, m)  collect_clock_pairs (inv_of A l). m  "
  unfolding clkp_set_def collect_clki_def inv_of_def using Nats_subset_Ints by auto
  from dbm_int_abstr[OF this] show ?thesis .
qed

lemma dbm_int_guard_abstr:
  assumes "valid_abstraction A X k" "A  lg,a,r l'"
  shows "dbm_int (abstr g (λi j. ) v) n"
proof -
  from assms have "(x,m)  clkp_set A. m  k x  x  X  m  "
  by (auto elim: valid_abstraction.cases)
  then have " (x, m)  collect_clock_pairs g. m  "
  unfolding clkp_set_def collect_clkt_def using assms(2) Nats_subset_Ints by fastforce
  from dbm_int_abstr[OF this] show ?thesis .
qed

lemma collect_clks_id: "collect_clks cc = fst ` collect_clock_pairs cc" by (induction cc) auto

subsection ‹Unused theorems›

lemma canonical_cyc_free:
  "canonical M n  i  n. M i i  𝟭  cyc_free M n"
proof (rule ccontr, auto, goal_cases)
  case 1
  with canonical_len[OF this(1,3,3,4)] show False by auto
qed

lemma canonical_cyc_free2:
  "canonical M n  cyc_free M n  (i  n. M i i  𝟭)"
 apply safe
  apply (simp add: cyc_free_diag_dest')
using canonical_cyc_free by blast

lemma DBM_reset'_diag_preservation:
  assumes "kn. M k k  𝟭" "clock_numbering v" " c  set cs. v c  n"
  shows "kn. reset' M n cs v d k k  𝟭" using assms
proof (induction cs)
  case Nil thus ?case by auto
next
  case (Cons c cs)
  then have IH: "kn. reset' M n cs v d k k  𝟭" by auto
  from Cons.prems have "v c > 0" "v c  n" by auto
  from DBM_reset_diag_preservation[of n "reset' M n cs v d", OF IH DBM_reset_reset, of "v c", OF this]
  show ?case by simp
qed

end

Theory DBM_Zone_Semantics

subsection ‹Semantics Based on DBMs›

theory DBM_Zone_Semantics
imports DBM_Operations
begin

subsection ‹Single Step›

inductive step_z_dbm ::
  "('a, 'c, 't, 's) ta  's  ('t::time) DBM
     ('c  nat)  nat  's  ('t::time) DBM  bool"
("_  _, _ ↝⇘_,_ _, _" [61,61,61] 61)
where
  step_t_z_dbm:
    "D_inv = abstr (inv_of A l) (λi j. ) v  A  l,Dv,n l,And (up (And D D_inv)) D_inv" |
  step_a_z_dbm:
    "A  lg,a,r l'
     A  l,Dv,n l',And (reset' (And D (abstr g (λi j. ) v)) n r v 0)
                                             (abstr (inv_of A l') (λi j. ) v)"
inductive_cases step_z_cases: "A  l, Dv,n l', D'"

declare step_z_dbm.intros[intro]

lemma step_z_dbm_preserves_int:
  assumes "A  l,Dv,n l',D'" "global_clock_numbering A v n" "valid_abstraction A X k"
          "dbm_int D n"
  shows "dbm_int D' n"
using assms
proof (cases, goal_cases)
  case (1 D'')
  hence "clock_numbering' v n" "cclk_set A. v c  n" by blast+
  from 1(2) have " (x, m)  clkp_set A. m  " by (auto elim: valid_abstraction.cases)
  from dbm_int_inv_abstr[OF this] 1 have D''_int: "dbm_int D'' n" by simp
  show ?thesis unfolding 1(5) by (intro And_int_preservation up_int_preservation dbm_int_inv_abstr D''_int 1)
next
  case (2 g a r)
  hence assms: "clock_numbering' v n" "cclk_set A. v c  n" "kn. k > 0  (c. v c = k)" by blast+
  from 2(2) have *: " (x, m)  clkp_set A. m  " by (auto elim: valid_abstraction.cases)
  from dbm_int_inv_abstr[OF this] have D'_int: "dbm_int (abstr (inv_of A l') (λi j. ) v) n" by simp
  from dbm_int_guard_abstr 2 have D''_int: "dbm_int (abstr g (λi j. ) v) n" by simp
  have "set r  clk_set A" using 2(5) unfolding trans_of_def collect_clkvt_def by fastforce
  hence **:"cset r. v c  n" using assms(2) by fastforce
  show ?thesis unfolding 2(4)
  by (intro And_int_preservation DBM_reset'_int_preservation dbm_int_inv_abstr 2 D''_int)
     (simp_all add: assms(1) * **)
qed

lemma And_correct:
  shows "[M1]v,n  [M2]v,n = [And M1 M2]v,n"
using DBM_and_sound1 DBM_and_sound2 DBM_and_complete unfolding DBM_zone_repr_def by auto

lemma up_correct:
  assumes "clock_numbering' v n"
  shows "[up M]v,n = [M]v,n"
using assms
 apply safe
  apply (rule DBM_up_sound')
   apply assumption+
 apply (rule DBM_up_complete')
  apply auto
done

lemma step_z_dbm_sound:
  assumes "A  l, Dv,n l', D'" "global_clock_numbering A v n"
  shows "A  l, [D]v,n  l', [D']v,n"
using assms
proof (cases, goal_cases)
  case (1 D'')
  hence "clock_numbering' v n" "cclk_set A. v c  n" by blast+
  note assms = assms(1) this
  from assms(3) have *: "ccollect_clks (inv_of A l). v c  n"
  unfolding clkp_set_def collect_clki_def inv_of_def by (fastforce simp: collect_clks_id)
  from 1 have D'':"[D'']v,n = {u. u  inv_of A l}" using dbm_abstr_zone_eq[OF assms(2) *] by metis
  with And_correct have A11: "[And D D'']v,n = ([D]v,n)  ({u. u  inv_of A l})" by blast
  with And_correct D'' have
    "[D']v,n = ([up (And D D'')]v,n)  ({u. u  inv_of A l})"
  unfolding 1(3) by blast
  with up_correct[OF assms(2)] A11 have
    "[D']v,n = (([D]v,n)  {u. u  inv_of A l})  {u. u  inv_of A l}"
  by metis
  with 1(2) show ?thesis by auto
next
  case (2 g a r)
  hence "clock_numbering' v n" "cclk_set A. v c  n" "kn. k > 0  (c. v c = k)" by blast+
  note assms = assms(1) this
  from assms(3) have *: "ccollect_clks (inv_of A l'). v c  n"
  unfolding clkp_set_def collect_clki_def inv_of_def by (fastforce simp: collect_clks_id)
  have D':
    "[abstr (inv_of A l') (λi j. ) v]v,n = {u. u  inv_of A l'}"
  using 2 dbm_abstr_zone_eq[OF assms(2) *] by simp
  from assms(3) 2(3) have *: "ccollect_clks g. v c  n" 
  unfolding clkp_set_def collect_clkt_def inv_of_def by (fastforce simp: collect_clks_id)
  have D'':"[abstr g (λi j. ) v]v,n = {u. u  g}" using 2 dbm_abstr_zone_eq[OF assms(2) *] by auto
  with And_correct have A11: "[And D (abstr g (λi j. ) v)]v,n = ([D]v,n)  ({u. u  g})" by blast
  let ?D = "reset' (And D (abstr g (λi j. ) v)) n r v 0"
  have "set r  clk_set A" using 2(3) unfolding trans_of_def collect_clkvt_def by fastforce
  hence **:"cset r. v c  n" using assms(3) by fastforce
  have D_reset: "[?D]v,n = zone_set (([D]v,n)  {u. u  g}) r"
  proof safe
    fix u assume u: "u  [?D]v,n"
    from DBM_reset'_sound[OF assms(4,2) ** this] obtain ts where
      "set_clocks r ts u  [And D (abstr g (λi j. ) v)]v,n"
    by auto
    with A11 have *: "set_clocks r ts u  ([D]v,n)  ({u. u  g})" by blast
    from DBM_reset'_resets[OF assms(4,2) **] u 
    have "c  set r. u c = 0" unfolding DBM_zone_repr_def by auto
    from reset_set[OF this] have "[r0]set_clocks r ts u = u" by simp
    with * show "u  zone_set (([D]v,n)  {u. u  g}) r" unfolding zone_set_def by force
  next
    fix u assume u: "u  zone_set (([D]v,n)  {u. u  g}) r"
    from DBM_reset'_complete[OF _ assms(2) **] u A11
    show "u  [?D]v,n" unfolding DBM_zone_repr_def zone_set_def by force
  qed
  from D' And_correct D_reset have A22:
    "[And ?D (abstr (inv_of A l') (λi j. ) v)]v,n = ([?D]v,n)  ({u. u  inv_of A l'})"
  by blast
  with D_reset 2(2,3) show ?thesis by auto
qed

lemma step_z_dbm_DBM:
  assumes "A  l, [D]v,n  l', Z" "global_clock_numbering A v n"
  obtains D' where "A  l, Dv,n l', D'" "Z = [D']v,n"
using assms
proof (cases, goal_cases)
  case 1
  hence "clock_numbering' v n" "cclk_set A. v c  n" by metis+
  note assms = assms(1) this
  from assms(3) have *: "ccollect_clks (inv_of A l). v c  n"
  unfolding clkp_set_def collect_clki_def inv_of_def by (fastforce simp: collect_clks_id)
  obtain D'' where D''_def: "D'' = abstr (inv_of A l) (λi j. ) v" by auto
  hence D'':"[D'']v,n = {u. u  inv_of A l}" using dbm_abstr_zone_eq[OF assms(2) *] by metis
  obtain A1 where A1: "A1 = And D D''" by fast
  with And_correct D'' have A11: "[A1]v,n = ([D]v,n)  ({u. u  inv_of A l})" by blast
  then obtain D_up where D_up': "D_up = up A1" by blast
  with up_correct assms(2) A11 have D_up: "[D_up]v,n = (([D]v,n)  ({u. u  inv_of A l}))" by metis
  obtain A2 where A2: "A2 = And D_up D''" by fast
  with And_correct D'' have A22: "[A2]v,n = ([D_up]v,n)  ({u. u  inv_of A l})" by blast
  from A2 D_up' D''_def A1 have "A  l,Dv,n l,A2" by blast
  moreover from A22 D_up have
    "[A2]v,n = (([D]v,n)  {u. u  inv_of A l})  {u. u  inv_of A l}"
  by auto
  ultimately show thesis using 1 by (intro that[of A2]) auto
next
  case (2 g a r)
  hence "clock_numbering' v n" "cclk_set A. v c  n" "kn. k > 0  (c. v c = k)" by metis+
  note assms = assms(1) this
  from assms(3) have *: "ccollect_clks (inv_of A l'). v c  n"
  unfolding clkp_set_def collect_clki_def inv_of_def by (fastforce simp: collect_clks_id)
  obtain D' where D'_def: "D' = abstr (inv_of A l') (λi j. ) v" by blast
  hence D':"[D']v,n = {u. u  inv_of A l'}" using dbm_abstr_zone_eq[OF assms(2) *] by simp
  from assms(3) 2(4) have *: "ccollect_clks g. v c  n" 
  unfolding clkp_set_def collect_clkt_def inv_of_def by (fastforce simp: collect_clks_id)
  obtain D'' where D''_def: "D'' = abstr g (λi j. ) v" by blast
  hence D'':"[D'']v,n = {u. u  g}" using dbm_abstr_zone_eq[OF assms(2) *] by auto
  obtain A1 where A1: "A1 = And D D''" by fast
  with And_correct D'' have A11: "[A1]v,n = ([D]v,n)  ({u. u  g})" by blast
  let ?D = "reset' A1 n r v 0"
  have "set r  clk_set A" using 2(4) unfolding trans_of_def collect_clkvt_def by fastforce
  hence **:"cset r. v c  n" using assms(3) by fastforce
  have D_reset: "[?D]v,n = zone_set (([D]v,n)  {u. u  g}) r"
  proof safe
    fix u assume u: "u  [?D]v,n"
    from DBM_reset'_sound[OF assms(4,2) ** this] obtain ts where
      "set_clocks r ts u  [A1]v,n"
    by auto
    with A11 have *: "set_clocks r ts u  ([D]v,n)  ({u. u  g})" by blast
    from DBM_reset'_resets[OF assms(4,2) **] u 
    have "c  set r. u c = 0" unfolding DBM_zone_repr_def by auto
    from reset_set[OF this] have "[r0]set_clocks r ts u = u" by simp
    with * show "u  zone_set (([D]v,n)  {u. u  g}) r" unfolding zone_set_def by force
  next
    fix u assume u: "u  zone_set (([D]v,n)  {u. u  g}) r"
    from DBM_reset'_complete[OF _ assms(2) **] u A11
    show "u  [?D]v,n" unfolding DBM_zone_repr_def zone_set_def by force
  qed
  obtain A2 where A2: "A2 = And ?D D'" by fast
  with And_correct D' have A22: "[A2]v,n = ([?D]v,n)  ({u. u  inv_of A l'})" by blast
  from 2(4) A2 D'_def D''_def A1 have "A  l,Dv,n l',A2" by blast
  moreover from A22 D_reset have
    "[A2]v,n = zone_set (([D]v,n)  {u. u  g}) r  {u. u  inv_of A l'}"
  by auto
  ultimately show ?thesis using 2 by (intro that[of A2]) simp+
qed

lemma step_z_computable:
  assumes "A  l, [D]v,n  l',Z" "global_clock_numbering A v n"
  obtains D' where "Z = [D']v,n"
using step_z_dbm_DBM[OF assms] by blast

lemma step_z_dbm_complete:
  assumes "global_clock_numbering A v n" "A  l, u  l',u'"
  and     "u  [(D )]v,n"
  shows " D'. A  l, Dv,n l',D'  u'  [D']v,n"
proof -
  note A = assms
  from step_z_complete[OF A(2,3)] obtain Z' where Z': "A  l, [D]v,n  l',Z'" "u'  Z'" by auto
  with step_z_dbm_DBM[OF Z'(1) A(1)] obtain D' where D':
    "A  l, Dv,n l',D'" "Z' = [D']v,n"
  by metis
  with Z'(2) show ?thesis by auto
qed


subsection ‹Multi Step›

inductive steps_z_dbm ::
  "('a, 'c, 't, 's) ta  's  ('t::time) DBM
     ('c  nat)  nat  's  ('t::time) DBM  bool"
("_  _, _ ↝*⇘_,_ _, _" [61,61,61] 61)
where
  refl: "A  l,D ↝*v,n l,D" |
  step: "A  l,Dv,n l',D'  A  l',D' ↝*v,n l'',D'' 
         A  l,D ↝*v,n l'',D''"

declare steps_z_dbm.intros[intro]

lemma steps_z_dbm_sound:
  assumes "A  l,D ↝*v,n l',D'"
  and "global_clock_numbering A v n"
  and "u'  [D']v,n"
  shows " u  [D]v,n. A  l, u →* l',u'" using assms
proof (induction A l D v n l' D' rule: steps_z_dbm.induct)
  case refl thus ?case by fast
next
  case (step A l D v n l' D' l'' D'')
  then obtain u'' where u'': "A  l', u'' →* l'',u'" "u''[D']v,n" by blast
  with step_z_sound[OF step_z_dbm_sound[OF step(1,4)]] obtain u where
    "u  [D]v,n" "A  l, u  l',u''"
  by blast
  with u'' show ?case by blast
qed

lemma steps_z_dbm_complete:
  assumes "A  l, u →* l',u'"
  and "global_clock_numbering A v n"
  and "u  [D]v,n"
  shows " D'. A  l, D ↝*v,n l', D'  u'  [D']v,n" using assms
proof (induction arbitrary: D rule: steps.induct)
  case refl thus ?case by auto
next
  case (step A l u l' u' l'' u'' D)
  from step_z_dbm_complete[OF step(4,1,5)] obtain D'
  where D': "A  l,Dv,n l',D'" "u'  [D']v,n" by auto
  with step(3)[OF step(4)] obtain D'' where
    "A  l',D' ↝*v,n l'',D''" "u''  [D'']v,n"
  by blast
  with D' show ?case by blast
qed

end
(*>*)

Theory Misc

(*<*)
theory Misc
imports Complex_Main
begin

chapter ‹Basic lemmas which do not belong to the particular domain of Timed Automata›

section ‹Reals›

subsection ‹Properties of fractions›

lemma frac_add_le_preservation:
  fixes a d :: real and b :: nat
  assumes "a < b" "d < 1 - frac a"
  shows "a + d < b"
proof -
  from assms have "a + d < a + 1 - frac a" by auto
  also have " = (a - frac a) + 1" by auto
  also have " = floor a + 1" unfolding frac_def by auto
  also have "  b" using a < b
  by (metis floor_less_iff int_less_real_le of_int_1 of_int_add of_int_of_nat_eq) 
  finally show "a + d < b" .
qed

lemma lt_lt_1_ccontr:
  "(a :: int) < b  b < a + 1  False" by auto

lemma int_intv_frac_gt0:
  "(a :: int) < b  b < a + 1  frac b > 0" by auto

lemma floor_frac_add_preservation:
  fixes a d :: real
  assumes "0 < d" "d < 1 - frac a"
  shows "floor a = floor (a + d)"
proof -
  have "frac a  0" by auto
  with assms(2) have "d < 1" by linarith
  from assms have "a + d < a + 1 - frac a" by auto
  also have " = (a - frac a) + 1" by auto
  also have " = (floor a) + 1" unfolding frac_def by auto
  finally have *: "a + d < floor a + 1" .
  have "floor (a + d)  floor a" using d > 0 by linarith
  moreover from * have "floor (a + d) < floor a + 1" by linarith
  ultimately show "floor a = floor (a + d)" by auto
qed

lemma frac_distr:
  fixes a d :: real
  assumes "0 < d" "d < 1 - frac a"
  shows "frac (a + d) > 0" "frac a + d = frac (a + d)"
proof -
  have "frac a  0" by auto
  with assms(2) have "d < 1" by linarith
  from assms have "a + d < a + 1 - frac a" by auto
  also have " = (a - frac a) + 1" by auto
  also have " = (floor a) + 1" unfolding frac_def by auto
  finally have *: "a + d < floor a + 1" .
  have **: "floor a < a + d" using assms(1) by linarith
  have "frac (a + d)  0"
  proof (rule ccontr, auto, goal_cases)
    case 1
    then obtain b :: int where "b = a + d" by (metis Ints_cases)
    with * ** have "b < floor a + 1" "floor a < b" by auto
    with lt_lt_1_ccontr show ?case by blast
  qed
  then show "frac (a + d) > 0" by auto
  from floor_frac_add_preservation assms have "floor a = floor (a + d)" by auto
  then show "frac a + d = frac (a + d)" unfolding frac_def by force
qed

lemma frac_add_leD:
  fixes a d :: real
  assumes "0 < d" "d < 1 - frac a" "d < 1 - frac b" "frac (a + d)  frac (b + d)"
  shows "frac a  frac b"
proof -
  from floor_frac_add_preservation assms have
    "floor a = floor (a + d)" "floor b = floor (b + d)"
  by auto
  with assms(4) show "frac a  frac b" unfolding frac_def by auto
qed

lemma floor_frac_add_preservation':
  fixes a d :: real
  assumes "0  d" "d < 1 - frac a"
  shows "floor a = floor (a + d)"
using assms floor_frac_add_preservation by (cases "d = 0") auto

lemma frac_add_leIFF:
  fixes a d :: real
  assumes "0  d" "d < 1 - frac a" "d < 1 - frac b"
  shows "frac a  frac b  frac (a + d)  frac (b + d)"
proof -
  from floor_frac_add_preservation' assms have
    "floor a = floor (a + d)" "floor b = floor (b + d)"
  by auto
  then show ?thesis unfolding frac_def by auto
qed

lemma nat_intv_frac_gt0:
  fixes c :: nat fixes x :: real
  assumes "c < x" "x < real (c + 1)"
  shows "frac x > 0"
proof (rule ccontr, auto, goal_cases)
  case 1
  then obtain d :: int where d: "x = d" by (metis Ints_cases)
  with assms have "c < d" "d < int c + 1" by auto
  with int_intv_frac_gt0[OF this] 1 d show False by auto
qed

lemma nat_intv_frac_decomp:
  fixes c :: nat and d :: real
  assumes "c < d" "d < c + 1"
  shows "d = c + frac d"
proof -
  from assms have "int c = d" by linarith
  thus ?thesis by (simp add: frac_def)
qed

lemma nat_intv_not_int:
  fixes c :: nat
  assumes "real c < d" "d < c + 1"
  shows "d  "
proof (standard, goal_cases)
  case 1
  then obtain k :: int where "d = k" using Ints_cases by auto
  then have "frac d = 0" by auto
  moreover from nat_intv_frac_decomp[OF assms] have *: "d = c + frac d" by auto
  ultimately have "d = c" by linarith
  with assms show ?case by auto
qed

lemma frac_idempotent: "frac (frac x) = frac x" by (simp add: frac_eq frac_lt_1)

lemma frac_nat_add_id: "frac ((n :: nat) + (r :: real)) = frac r" ― ‹Found by sledgehammer›
proof -
  have "r. frac (r::real) < 1"
    by (meson frac_lt_1)
  then show ?thesis
    by (simp add: floor_add frac_def)
qed

lemma floor_nat_add_id: "0  (r :: real)  r < 1  floor (real (n::nat) + r) = n" by linarith

lemma int_intv_frac_gt_0':
  "(a :: real)    (b :: real)    a  b  a  b  a  b - 1"
proof (goal_cases)
  case 1
  then have "a < b" by auto
  from 1(1,2) obtain k l :: int where "a = real_of_int k" "b = real_of_int l" by (metis Ints_cases)
  with a < b show ?case by auto
qed

lemma int_lt_Suc_le:
  "(a :: real)    (b :: real)    a < b + 1  a  b"
proof (goal_cases)
  case 1
  from 1(1,2) obtain k l :: int where "a = real_of_int k" "b = real_of_int l" by (metis Ints_cases)
  with a < b + 1 show ?case by auto
qed

lemma int_lt_neq_Suc_lt:
  "(a :: real)    (b :: real)    a < b  a + 1  b  a + 1 < b"
proof (goal_cases)
  case 1
  from 1(1,2) obtain k l :: int where "a = real_of_int k" "b = real_of_int l" by (metis Ints_cases)
  with 1 show ?case by auto
qed

lemma int_lt_neq_prev_lt:
  "(a :: real)    (b :: real)    a - 1 < b  a  b  a < b"
proof (goal_cases)
  case 1
  from 1(1,2) obtain k l :: int where "a = real_of_int k" "b = real_of_int l" by (metis Ints_cases)
  with 1 show ?case by auto
qed

lemma ints_le_add_frac1:
  fixes a b x :: real
  assumes "0 < x" "x < 1" "a  " "b  " "a + x  b"
  shows "a  b"
using assms by auto

lemma ints_le_add_frac2:
  fixes a b x :: real
  assumes "0  x" "x < 1" "a  " "b  " "b  a + x"
  shows "b  a"
using assms
by (metis add.commute add_le_cancel_left add_mono_thms_linordered_semiring(1) int_lt_Suc_le leD le_less_linear)

section ‹Ordering Fractions›

lemma distinct_twice_contradiction:
  "xs ! i = x  xs ! j = x  i < j  j < length xs  ¬ distinct xs"
proof (rule ccontr, simp, induction xs arbitrary: i j)
  case Nil thus ?case by auto
next
  case (Cons y xs)
  show ?case
  proof (cases "i = 0")
    case True
    with Cons have "y = x" by auto
    moreover from True Cons have "x  set xs" by auto
    ultimately show False using Cons(6) by auto
  next
    case False
    with Cons have
      "xs ! (i - 1) = x" "xs ! (j - 1) = x" "i - 1 < j - 1" "j - 1 < length xs" "distinct xs"
    by auto
    from Cons.IH[OF this] show False .
  qed
qed

lemma distinct_nth_unique:
  "xs ! i = xs ! j  i < length xs  j < length xs  distinct xs  i = j"
  apply (rule ccontr)
  apply (cases "i < j")
  apply auto
  apply (auto dest: distinct_twice_contradiction)
using distinct_twice_contradiction by fastforce

lemma (in linorder) linorder_order_fun:
  fixes S :: "'a set"
  assumes "finite S"
  obtains f :: "'a  nat"
  where "( x  S.  y  S. f x  f y  x  y)" and "range f  {0..card S - 1}"
proof -
  obtain l where l_def: "l = sorted_list_of_set S" by auto
  with assms have l: "set l = S" "sorted l" "distinct l" by auto
  from l(1,3) ‹finite S have len: "length l = card S" using distinct_card by force 
  let ?f = "λ x. if x  S then 0 else THE i. i < length l  l ! i = x"
  { fix x y assume A: "x  S" "y  S" "x < y"
    with l(1) obtain i j where *: "l ! i = x" "l ! j = y" "i < length l" "j < length l"
    by (meson in_set_conv_nth)
    have "i < j"
    proof (rule ccontr, goal_cases)
      case 1
      with sorted_nth_mono[OF l(2)] i < length l have "l ! j  l ! i" by auto
      with * A(3) show False by auto
    qed
    moreover have "?f x = i" using * l(3) A(1) by (auto) (rule, auto intro: distinct_nth_unique)
    moreover have "?f y = j" using * l(3) A(2) by (auto) (rule, auto intro: distinct_nth_unique)
    ultimately have "?f x < ?f y" by auto
  } moreover
  { fix x y assume A: "x  S" "y  S" "?f x < ?f y"
    with l(1) obtain i j where *: "l ! i = x" "l ! j = y" "i < length l" "j < length l"
    by (meson in_set_conv_nth)
    moreover have "?f x = i" using * l(3) A(1) by (auto) (rule, auto intro: distinct_nth_unique)
    moreover have "?f y = j" using * l(3) A(2) by (auto) (rule, auto intro: distinct_nth_unique)
    ultimately have **: "l ! ?f x = x" "l ! ?f y = y" "i < j" using A(3) by auto
    have "x < y"
    proof (rule ccontr, goal_cases)
      case 1
      then have "y  x" by simp
      moreover from sorted_nth_mono[OF l(2), of i j] **(3) * have "x  y" by auto
      ultimately show False using distinct_nth_unique[OF _ *(3,4) l(3)] *(1,2) **(3) by fastforce
    qed
  }
  ultimately have " x  S.  y  S. ?f x  ?f y  x  y" by force
  moreover have "range ?f  {0..card S - 1}"
  proof (auto, goal_cases)
    case (1 x)
    with l(1) obtain i where *: "l ! i = x" "i < length l" by (meson in_set_conv_nth)
    then have "?f x = i" using l(3) 1 by (auto) (rule, auto intro: distinct_nth_unique)
    with len show ?case using *(2) 1 by auto
  qed
  ultimately show ?thesis ..
qed

locale enumerateable =
  fixes T :: "'a set"
  fixes less :: "'a  'a  bool" (infix "" 50)
  assumes finite: "finite T"
  assumes total:  " x  T.  y  T. x  y  (x  y)  (y  x)"
  assumes trans:  "x  T.  y  T.  z  T. (x :: 'a)  y  y  z  x  z"
  assumes asymmetric: " x  T.  y  T. x  y  ¬ (y  x)"
begin

lemma non_empty_set_has_least':
  "S  T  S  {}   x  S.  y  S. x  y  ¬ y  x"
proof (rule ccontr, induction "card S" arbitrary: S)
  case 0 then show ?case using finite by (auto simp: finite_subset)
next
  case (Suc n)
  then obtain x where x: "x  S" by blast
  from finite Suc.prems(1) have finite: "finite S" by (auto simp: finite_subset)
  let ?S = "S - {x}"
  show ?case
  proof (cases "S = {x}")
    case True
    with Suc.prems(3) show False by auto
  next
    case False
    then have S: "?S  {}" using x by blast
    show False
    proof (cases "x  ?S. y?S. x  y  ¬ y  x")
      case False
      have "n = card ?S" using Suc.hyps finite by (simp add: x)
      from Suc.hyps(1)[OF this _ S False] Suc.prems(1) show False by auto
    next
      case True
      then obtain x' where x': "y?S. x'  y  ¬ y  x'" "x'  ?S" "x  x'" by auto
      from total Suc.prems(1) x'(2) have " y. y  S  x'  y  ¬ y  x'  x'  y" by auto
      from total Suc.prems(1) x'(1,2) have *: " y  ?S. x'  y  x'  y" by auto
      from Suc.prems(3) x'(1,2) have **: "x  x'" by auto
      have " y  ?S. x  y"
      proof
        fix y assume y: "y  S - {x}"
        show "x  y"
        proof (cases "y = x'")
          case True then show ?thesis using ** by simp
        next
          case False
          with * y have "x'  y" by auto
          with trans Suc.prems(1) ** y x'(2) x ** show ?thesis by auto
        qed
      qed
      with x Suc.prems(1,3) show False using asymmetric by blast
    qed
  qed
qed

lemma non_empty_set_has_least'':
  "S  T  S  {}  ∃! x  S.  y  S. x  y  ¬ y  x"
proof (intro ex_ex1I, goal_cases)
  case 1
  with non_empty_set_has_least'[OF this] show ?case by auto
next
  case (2 x y)
  show ?case
  proof (rule ccontr)
    assume "x  y"
    with 2 total have "x  y  y  x" by blast
    with 2(2-) x  y show False by auto
  qed
qed

abbreviation "least S  THE t :: 'a. t  S  ( y  S. t  y  ¬ y  t)"

lemma non_empty_set_has_least:
  "S  T  S  {}  least S  S  ( y  S. least S  y  ¬ y  least S)"
proof goal_cases
  case 1
  note A = this
  show ?thesis
  proof (rule theI', goal_cases)
    case 1
    from non_empty_set_has_least''[OF A] show ?case .
  qed
qed

fun f :: "'a set  nat  'a list"
where
  "f S 0 = []" |
  "f S (Suc n) = least S # f (S - {least S}) n"

inductive sorted :: "'a list  bool" where
  Nil [iff]: "sorted []"
| Cons: "yset xs. x  y  sorted xs  sorted (x # xs)"

lemma f_set:
  "S  T  n = card S  set (f S n) = S"
proof (induction n arbitrary: S)
  case 0 then show ?case using finite by (auto simp: finite_subset)
next
  case (Suc n)
  then have fin: "finite S" using finite by (auto simp: finite_subset)
  with Suc.prems have "S  {}" by auto
  from non_empty_set_has_least[OF Suc.prems(1) this] have least: "least S  S" by blast
  let ?S = "S - {least S}"
  from fin least Suc.prems have "?S  T" "n = card ?S" by auto
  from Suc.IH[OF this] have "set (f ?S n) = ?S" .
  with least show ?case by auto
qed

lemma f_distinct:
  "S  T  n = card S  distinct (f S n)"
proof (induction n arbitrary: S)
  case 0 then show ?case using finite by (auto simp: finite_subset)
next
  case (Suc n)
  then have fin: "finite S" using finite by (auto simp: finite_subset)
  with Suc.prems have "S  {}" by auto
  from non_empty_set_has_least[OF Suc.prems(1) this] have least: "least S  S" by blast
  let ?S = "S - {least S}"
  from fin least Suc.prems have "?S  T" "n = card ?S" by auto
  from Suc.IH[OF this] f_set[OF this] have "distinct (f ?S n)" "set (f ?S n) = ?S" .
  then show ?case by simp
qed

lemma f_sorted:
  "S  T  n = card S  sorted (f S n)"
proof (induction n arbitrary: S)
  case 0 then show ?case by auto
next
  case (Suc n)
  then have fin: "finite S" using finite by (auto simp: finite_subset)
  with Suc.prems have "S  {}" by auto
  from non_empty_set_has_least[OF Suc.prems(1) this] have least:
    "least S  S" "( y  S. least S  y  ¬ y  least S)"
  by blast+
  let ?S = "S - {least S}"
  { fix x assume x: "x  ?S"
    with least have "¬ x  least S" by auto
    with total x Suc.prems(1) least(1) have "least S  x" by blast
  } note le = this
  from fin least Suc.prems have "?S  T" "n = card ?S" by auto
  from f_set[OF this] Suc.IH[OF this] have *: "set (f ?S n) = ?S" "sorted (f ?S n)" .
  with le have " x  set (f ?S n). least S  x" by auto
  with *(2) show ?case by (auto intro: Cons)
qed

lemma sorted_nth_mono:
  "sorted xs  i < j  j < length xs  xs!i  xs!j"
proof (induction xs arbitrary: i j)
  case Nil thus ?case by auto
next
  case (Cons x xs)
  show ?case
  proof (cases "i = 0")
    case True
    with Cons.prems show ?thesis by (auto elim: sorted.cases)
  next
    case False
    from Cons.prems have "sorted xs" by (auto elim: sorted.cases)
    from Cons.IH[OF this] Cons.prems False show ?thesis by auto
  qed
qed

lemma order_fun:
  fixes S :: "'a set"
  assumes "S  T"
  obtains f :: "'a  nat" where " x  S.  y  S. f x < f y  x  y" and "range f  {0..card S - 1}"
proof -
  obtain l where l_def: "l = f S (card S)" by auto
  with f_set f_distinct f_sorted assms have l: "set l = S" "sorted l" "distinct l" by auto
  then have len: "length l = card S" using distinct_card by force
  let ?f = "λ x. if x  S then 0 else THE i. i < length l  l ! i = x"
  { fix x y :: 'a assume A: "x  S" "y  S" "x  y"
    with l(1) obtain i j where *: "l ! i = x" "l ! j = y" "i < length l" "j < length l"
    by (meson in_set_conv_nth)
    have "i  j"
    proof (rule ccontr, goal_cases)
      case 1
      with A * have "x  x" by auto
      with asymmetric A assms show False by auto
    qed
    have "i < j"
    proof (rule ccontr, goal_cases)
      case 1
      with i  j sorted_nth_mono[OF l(2)] i < length l have "l ! j  l ! i" by auto
      with * A(3) A assms asymmetric show False by auto
    qed
    moreover have "?f x = i" using * l(3) A(1) by (auto) (rule, auto intro: distinct_nth_unique)
    moreover have "?f y = j" using * l(3) A(2) by (auto) (rule, auto intro: distinct_nth_unique)
    ultimately have "?f x < ?f y" by auto
  } moreover
  { fix x y assume A: "x  S" "y  S" "?f x < ?f y"
    with l(1) obtain i j where *: "l ! i = x" "l ! j = y" "i < length l" "j < length l"
    by (meson in_set_conv_nth)
    moreover have "?f x = i" using * l(3) A(1) by (auto) (rule, auto intro: distinct_nth_unique)
    moreover have "?f y = j" using * l(3) A(2) by (auto) (rule, auto intro: distinct_nth_unique)
    ultimately have **: "l ! ?f x = x" "l ! ?f y = y" "i < j" using A(3) by auto
    from sorted_nth_mono[OF l(2), of i j] **(3) * have "x  y" by auto
  }
  ultimately have " x  S.  y  S. ?f x < ?f y  x  y" by force
  moreover have "range ?f  {0..card S - 1}"
  proof (auto, goal_cases)
    case (1 x)
    with l(1) obtain i where *: "l ! i = x" "i < length l" by (meson in_set_conv_nth)
    then have "?f x = i" using l(3) 1 by (auto) (rule, auto intro: distinct_nth_unique)
    with len show ?case using *(2) 1 by auto
  qed
  ultimately show ?thesis ..
qed

end

lemma finite_total_preorder_enumeration:
  fixes X :: "'a set"
  fixes r :: "'a rel"
  assumes fin:   "finite X"
  assumes tot:   "total_on X r"
  assumes refl:  "refl_on X r"
  assumes trans: "trans r"
  obtains f :: "'a  nat" where " x  X.  y  X. f x  f y  (x, y)  r"
proof -
  let ?A = "λ x. {y  X . (y, x)  r  (x, y)  r}"
  have ex: " x  X. x  ?A x" using refl unfolding refl_on_def by auto
  let ?R = "λ S. SOME y. y  S"
  let ?T = "{?A x | x.  x  X}"
  { fix A assume A: "A  ?T"
    then obtain x where x: "x  X" "?A x = A" by auto
    then have "x  A" using refl unfolding refl_on_def by auto
    then have "?R A  A" by (auto intro: someI)
    with x(2) have "(?R A, x)  r" "(x, ?R A)  r" by auto
    with trans have "(?R A, ?R A)  r" unfolding trans_def by blast
  } note refl_lifted = this
  { fix A assume A: "A  ?T"
    then obtain x where x: "x  X" "?A x = A" by auto
    then have "x  A" using refl unfolding refl_on_def by auto
    then have "?R A  A" by (auto intro: someI)
  } note R_in = this
  { fix A y z assume A: "A  ?T" and y: "y  A" and z: "z  A"
    from A obtain x where x: "x  X" "?A x = A" by auto
    then have "x  A" using refl unfolding refl_on_def by auto
    with x y have "(x, y)  r" "(y, x)  r" by auto
    moreover from x z have "(x,z)  r" "(z,x)  r" by auto
    ultimately have "(y, z)  r" "(z, y)  r" using trans unfolding trans_def by blast+
  } note A_dest' = this
  { fix A y assume "A  ?T" and "y  A"
    with A_dest'[OF _ _ R_in] have "(?R A, y)  r" "(y, ?R A)  r" by blast+
  } note A_dest = this
  { fix A y z assume A: "A  ?T" and y: "y  A" and z: "z  X" and r: "(y, z)  r" "(z, y)  r"
    from A obtain x where x: "x  X" "?A x = A" by auto
    then have "x  A" using refl unfolding refl_on_def by auto
    with x y have "(x,y)  r" "(y, x)  r" by auto
    with r have "(x,z)  r" "(z,x)  r" using trans unfolding trans_def by blast+
    with x z have "z  A" by auto
  } note A_intro' = this
  { fix A y assume A: "A  ?T" and y: "y  X" and r: "(?R A, y)  r" "(y, ?R A)  r"
    with A_intro' R_in have "y  A" by blast
  } note A_intro = this
  { fix A B C
    assume r1: "(?R A, ?R B)  r" and r2: "(?R B, ?R C)  r"
    with trans have "(?R A, ?R C)  r" unfolding trans_def by blast
  } note trans_lifted[intro] = this
  { fix A B a b
    assume A: "A  ?T" and B: "B  ?T"
    and a: "a  A" and b: "b  B"
    and r: "(a, b)  r" "(b, a)  r"
    with R_in have "?R A  A" "?R B  B" by blast+
    have "A = B"
    proof auto
      fix x assume x: "x  A"
      with A have "x  X" by auto
      from A_intro'[OF B b this] A_dest'[OF A x a] r trans[unfolded trans_def] show "x  B" by blast
    next
      fix x assume x: "x  B"
      with B have "x  X" by auto
      from A_intro'[OF A a this] A_dest'[OF B x b] r trans[unfolded trans_def] show "x  A" by blast
    qed
  } note eq_lifted'' = this
  { fix A B C
    assume A: "A  ?T" and B: "B  ?T" and r: "(?R A, ?R B)  r" "(?R B, ?R A)  r"
    with eq_lifted'' R_in have "A = B" by blast
  } note eq_lifted' = this
  { fix A B C
    assume A: "A  ?T" and B: "B  ?T" and eq: "?R A = ?R B"
    from R_in[OF A] A have "?R A  X" by auto
    with refl have "(?R A, ?R A)  r" unfolding refl_on_def by auto
    with eq_lifted'[OF A B] eq have "A = B" by auto
  } note eq_lifted = this
  { fix A B
    assume A: "A  ?T" and B: "B  ?T" and neq: "A  B"
    from neq eq_lifted[OF A B] have "?R A  ?R B" by metis
    moreover from A B R_in have "?R A  X" "?R B  X" by auto
    ultimately have "(?R A, ?R B)  r  (?R B, ?R A)  r" using tot unfolding total_on_def by auto
  } note total_lifted = this
  { fix x y assume x: "x  X" and y: "y  X"
    from x y have "?A x  ?T" "?A y  ?T" by auto
    from R_in[OF this(1)] R_in[OF this(2)] have "?R (?A x)  ?A x" "?R (?A y)  ?A y" by auto
    then have "(x, ?R (?A x))  r" "(?R (?A y), y)  r" "(?R (?A x), x)  r" "(y, ?R (?A y))  r" by auto
    with trans[unfolded trans_def] have "(x, y)  r  (?R (?A x), ?R (?A y))  r" by meson
  } note repr = this
  interpret interp: enumerateable "{?A x | x.  x  X}" "λ A B. A  B  (?R A, ?R B)  r"
  proof (standard, goal_cases)
    case 1
    from fin show ?case by auto
  next
    case 2
    with total_lifted show ?case by auto
  next
    case 3
    then show ?case unfolding transp_def
    proof (standard, standard, standard, standard, standard, goal_cases)
      case (1 A B C)
      note A = this
      with trans_lifted have "(?R A,?R C)  r" by blast
      moreover have "A  C"
      proof (rule ccontr, goal_cases)
        case 1
        with A have "(?R A,?R B)  r" "(?R B,?R A)  r" by auto
        with eq_lifted'[OF A(1,2)] A show False by auto
      qed
      ultimately show ?case by auto
    qed
  next
    case 4
    { fix A B assume A: "A  ?T" and B: "B  ?T" and neq: "A  B" "(?R A, ?R B)  r"
      with eq_lifted'[OF A B] neq have "¬ (?R B, ?R A)  r" by auto
    }
    then show ?case by auto
  qed
  from interp.order_fun[OF subset_refl] obtain f :: "'a set  nat" where
    f: " x  ?T.  y  ?T. f x < f y  x  y  (?R x, ?R y)  r" "range f  {0..card ?T - 1}"
  by auto
  let ?f = "λ x. if x  X then f (?A x) else 0"
  { fix x y assume x: "x  X" and y: "y  X"
    have "?f x  ?f y  (x, y)  r"
    proof (cases "x = y")
      case True
      with refl x show ?thesis unfolding refl_on_def by auto
    next
      case False
      note F = this
      from ex x y have *: "?A x  ?T" "?A y  ?T" "x  ?A x" "y  ?A y" by auto
      show ?thesis
      proof (cases "(x, y)  r  (y, x)  r")
        case True
        from eq_lifted''[OF *] True x y have "?f x = ?f y" by auto
        with True show ?thesis by auto
      next
        case False
        with A_dest'[OF *(1,3), of y] *(4) have **: "?A x  ?A y" by auto
        from total_lifted[OF *(1,2) this] have "(?R (?A x), ?R (?A y))  r  (?R (?A y), ?R (?A x))  r" .
        then have neq: "?f x  ?f y"
        proof (standard, goal_cases)
          case 1
          with f *(1,2) ** have "f (?A x) < f (?A y)" by auto
          with * show ?case by auto
        next
          case 2
          with f *(1,2) ** have "f (?A y) < f (?A x)" by auto
          with * show ?case by auto
        qed
        then have "?thesis = (?f x < ?f y  (x, y)  r)" by linarith
        moreover from f ** * have "(?f x < ?f y  (?R (?A x), ?R (?A y))  r)" by auto
        moreover from repr * have "  (x, y)  r" by auto
        ultimately show ?thesis by auto
      qed
    qed
  }
  then have " x  X.  y  X. ?f x  ?f y  (x, y)  r" by blast
  then show ?thesis ..
qed

section ‹Finiteness›

lemma pairwise_finiteI:
  assumes "finite {b. a. P a b}" (is "finite ?B")
  assumes "finite {a. b. P a b}"
  shows "finite {(a,b). P a b}" (is "finite ?C")
proof -
  from assms(1) have "finite ?B" .
  let ?f = "λ b. {(a,b) | a. P a b}"
  { fix b
    have "?f b  {(a,b) | a. b. P a b}" by blast
    moreover have "finite " using assms(2) by auto 
    ultimately have "finite (?f b)" by (blast intro: finite_subset)
  }
  with assms(1) have "finite ( (?f ` ?B))" by auto
  moreover have "?C   (?f ` ?B)" by auto
  ultimately show ?thesis by (blast intro: finite_subset)
qed

lemma finite_ex_and1:
  assumes "finite {b. a. P a b}" (is "finite ?A")
  shows "finite {b. a. P a b  Q a b}" (is "finite ?B")
proof -
  have "?B  ?A" by auto
  with assms show ?thesis by (blast intro: finite_subset)
qed

lemma finite_ex_and2:
  assumes "finite {b. a. Q a b}" (is "finite ?A")
  shows "finite {b. a. P a b  Q a b}" (is "finite ?B")
proof -
  have "?B  ?A" by auto
  with assms show ?thesis by (blast intro: finite_subset)
qed

lemma finite_set_of_finite_funs2:
  fixes A :: "'a set" 
    and B :: "'b set"
    and C :: "'c set"
    and d :: "'c" 
  assumes "finite A"
    and "finite B"
    and "finite C"
  shows "finite {f. x. y. (x  A  y  B  f x y  C)  (x  A  f x y = d)  (y  B  f x y = d)}"
proof -
  let ?S = "{f. x. y. (x  A  y  B  f x y  C)  (x  A  f x y = d)  (y  B  f x y = d)}"
  let ?R = "{g. x. (x  B  g x  C)  (x  B  g x = d)}"
  let ?Q = "{f. x. (x  A  f x  ?R)  (x  A  f x = (λy. d))}"
  from finite_set_of_finite_funs[OF assms(2,3)] have "finite ?R" .
  from finite_set_of_finite_funs[OF assms(1) this, of "λ y. d"] have "finite ?Q" .
  moreover have "?S = ?Q" by auto (case_tac "xa  A", auto)
  ultimately show ?thesis by simp
qed

section ‹Numbering the elements of finite sets›

lemma upt_last_append: "a  b  [a..<b] @ [b] = [a ..< Suc b]" by (induction b) auto

lemma map_of_zip_dom_to_range:
  "a  set A  length B = length A  the (map_of (zip A B) a)  set B"
by (metis map_of_SomeD map_of_zip_is_None option.collapse set_zip_rightD)

lemma zip_range_id:
  "length A = length B  snd ` set (zip A B) = set B"
by (metis map_snd_zip set_map)

lemma map_of_zip_in_range:
  "distinct A  length B = length A  b  set B   a  set A. the (map_of (zip A B) a) = b"
proof goal_cases
  case 1
  from ran_distinct[of "zip A B"] 1(1,2) have
    "ran (map_of (zip A B)) = set B"
  by (auto simp: zip_range_id)
  with 1(3) obtain a where "map_of (zip A B) a = Some b" unfolding ran_def by auto
  with map_of_zip_is_Some[OF 1(2)[symmetric]] have "the (map_of (zip A B) a) = b" "a  set A" by auto
  then show ?case by blast
qed

lemma distinct_zip_inj:
  "distinct ys  (a, b)  set (zip xs ys)  (c, b)  set (zip xs ys)  a = c"
proof (induction ys arbitrary: xs)
  case Nil then show ?case by auto
next
  case (Cons y ys)
  from this(3) have "xs  []" by auto
  then obtain z zs where xs: "xs = z # zs" by (cases xs) auto
  show ?case
  proof (cases "(a, b)  set (zip zs ys)")
    case True
    note T = this
    then have b: "b  set ys" by (meson in_set_zipE) 
    show ?thesis
    proof (cases "(c, b)  set (zip zs ys)")
      case True
      with T Cons show ?thesis by auto
    next
      case False
      with Cons.prems xs b show ?thesis by auto
    qed
  next
    case False
    with Cons.prems xs have b: "a = z" "b = y" by auto
    show ?thesis
    proof (cases "(c, b)  set (zip zs ys)")
      case True
      then have "b  set ys" by (meson in_set_zipE)
      with b ‹distinct (y#ys) show ?thesis by auto
    next
      case False
      with Cons.prems xs b show ?thesis by auto
    qed
  qed
qed

lemma map_of_zip_distinct_inj:
  "distinct B  length A = length B  inj_on (the o map_of (zip A B)) (set A)"
unfolding inj_on_def proof (clarify, goal_cases)
  case (1 x y)
  with map_of_zip_is_Some[OF 1(2)] obtain a where
    "map_of (zip A B) x = Some a" "map_of (zip A B) y = Some a"
  by auto
  then have "(x, a)  set (zip A B)" "(y, a)  set (zip A B)" using map_of_SomeD by metis+
  from distinct_zip_inj[OF _ this] 1 show ?case by auto
qed

lemma nat_not_ge_1D: "¬ Suc 0  x  x = 0" by auto

lemma standard_numbering:
  assumes "finite A"
  obtains v :: "'a  nat" and n where "bij_betw v A {1..n}"
  and " c  A. v c > 0"
  and " c. c  A  v c > n"
proof -
  from assms obtain L where L: "distinct L" "set L = A" by (meson finite_distinct_list)
  let ?N = "length L + 1"
  let ?P = "zip L [1..<?N]"
  let ?v = "λ x. let v = map_of ?P x in if v = None then ?N else the v"
  from length_upt have len: "length [1..<?N] = length L" by auto (cases L, auto)
  then have lsimp: "length [Suc 0 ..<Suc (length L)] = length L" by simp
  note * = map_of_zip_dom_to_range[OF _ len]
  have "bij_betw ?v A {1..length L}" unfolding bij_betw_def
  proof
    show "?v ` A = {1..length L}" apply auto
      apply (auto simp: L)[] 
      apply (auto simp only: upt_last_append)[] using * apply force
      using * apply (simp only: upt_last_append) apply force
      apply (simp only: upt_last_append) using L(2) apply (auto dest: nat_not_ge_1D)
      apply (subgoal_tac "x  set [1..< length L +1]")
      apply (force dest!: map_of_zip_in_range[OF L(1) len])
      apply auto
    done
  next
    from L map_of_zip_distinct_inj[OF distinct_upt, of L 1 "length L + 1"] len
    have "inj_on (the o map_of ?P) A" by auto
    moreover have "inj_on (the o map_of ?P) A = inj_on ?v A"
    using len L(2) by - (rule inj_on_cong, auto)
    ultimately show "inj_on ?v A" by blast
  qed
  moreover have " c  A. ?v c > 0"
  proof
    fix c
    show "?v c > 0"
    proof (cases "c  set L")
      case False
      then show ?thesis by auto
    next
      case True
      with dom_map_of_zip[OF len[symmetric]] obtain x where
        "Some x = map_of ?P c" "x  set [1..<length L + 1]"
      by (metis * domIff option.collapse)
      then have "?v c  set [1..<length L + 1]" using * True len by auto
      then show ?thesis by auto
    qed
  qed
  moreover have " c. c  A  ?v c > length L" using L by auto
  ultimately show ?thesis ..
qed

end
(*>*)

Theory DBM_Normalization

section ‹Normalization of DBMs›

theory DBM_Normalization
imports DBM_Basics
begin

text ‹This is the implementation of the common approximation operation.›

fun norm_upper :: "('t::time) DBMEntry  't  ('t::time) DBMEntry"
where
  "norm_upper e t = (if Le t  e then  else e)"
  
fun norm_lower :: "('t::time) DBMEntry  't  ('t::time) DBMEntry"
where
  "norm_lower e t = (if e  Lt t then Lt t else e)"

text ‹
  Note that literature pretends that 𝟬› would have some (presumably infinite bound) in k›
  and thus defines normalization uniformly. The easiest way to get around this seems to explicate
  this in the definition as below.
›
definition norm :: "('t::time) DBM  (nat  't)  nat  't DBM"
where
  "norm M k n  λ i j.
    let ub = if i > 0 then (k i) else 0 in
    let lb = if j > 0 then (- k j) else 0 in
    if i  n  j  n then norm_lower (norm_upper (M i j) ub) lb else M i j
  "

section ‹Normalization is a Widening Operator›

lemma norm_mono:
  assumes "c. v c > 0" "u  [M]v,n"
  shows "u  [norm M k n]v,n" (is "u  [?M2]v,n")
proof -
  note A = assms
  note M1 = A(2)[unfolded DBM_zone_repr_def DBM_val_bounded_def]
  show ?thesis
  proof (unfold DBM_zone_repr_def DBM_val_bounded_def, auto)
    show "Le 0  ?M2 0 0"
    using A unfolding norm_def DBM_zone_repr_def DBM_val_bounded_def dbm_le_def by auto
  next
    fix c assume "v c  n"
    with M1 have M1: "dbm_entry_val u None (Some c) (M 0 (v c))" by auto
    from v c  n A have *:
      "?M2 0 (v c) = norm_lower (norm_upper (M 0 (v c)) 0) (- k (v c))"
    unfolding norm_def by auto
    show "dbm_entry_val u None (Some c) (?M2 0 (v c))"
    proof (cases "M 0 (v c)  Lt (- k (v c))")
      case True
      show ?thesis
      proof (cases "Le 0  M 0 (v c)")
        case True with * show ?thesis by auto
      next
        case False 
        with * True have "?M2 0 (v c) = Lt (- k (v c))" by auto
        moreover from True dbm_entry_val_mono_2[OF M1] have
          "dbm_entry_val u None (Some c) (Lt (- k (v c)))"
        by auto
        ultimately show ?thesis by auto
      qed
    next
      case False
      show ?thesis
      proof (cases "Le 0  M 0 (v c)")
        case True with * show ?thesis by auto
      next
        case F: False
        with M1 * False show ?thesis by auto
      qed
    qed
  next
    fix c assume "v c  n"
    with M1 have M1: "dbm_entry_val u (Some c) None (M (v c) 0)" by auto
    from v c  n A have *:
      "?M2 (v c) 0 = norm_lower (norm_upper (M (v c) 0) (k (v c))) 0"
    unfolding norm_def by auto
    show "dbm_entry_val u (Some c) None (?M2 (v c) 0)"
    proof (cases "Le (k (v c))  M (v c) 0")
      case True
      with A(1,2) v c  n have "?M2 (v c) 0 = " unfolding norm_def by auto
      then show ?thesis by auto
    next
      case False
      show ?thesis
      proof (cases "M (v c) 0  Lt 0")
        case True with False * dbm_entry_val_mono_3[OF M1] show ?thesis by auto
      next
        case F: False
        with M1 * False show ?thesis by auto
      qed
    qed
  next
    fix c1 c2 assume "v c1  n" "v c2  n"
    with M1 have M1: "dbm_entry_val u (Some c1) (Some c2) (M (v c1) (v c2))" by auto
    then show "dbm_entry_val u (Some c1) (Some c2) (?M2 (v c1) (v c2))"
    proof (cases "Le (k (v c1))  M (v c1) (v c2)")
      case True
      with A(1,2) v c1  n v c2  n have "?M2 (v c1) (v c2) = " unfolding norm_def by auto
      then show ?thesis by auto
    next
      case False
      with A(1,2) v c1  n v c2  n have
        *: "?M2 (v c1) (v c2) = norm_lower (M (v c1) (v c2)) (- k (v c2))"
      unfolding norm_def by auto
      show ?thesis
      proof (cases "M (v c1) (v c2)  Lt (- k (v c2))")
        case True
        with dbm_entry_val_mono_1[OF M1] have
          "dbm_entry_val u (Some c1) (Some c2) (Lt (- k (v c2)))"
        by auto
        then have "u c1 - u c2 < - k (v c2)" by auto
        with * True show ?thesis by auto
      next
        case False with M1 * show ?thesis by auto
      qed
    qed
  qed
qed

end

Theory Regions_Beta

theory Regions_Beta
imports Misc DBM_Normalization DBM_Operations
begin

chapter ‹Refinement to β›-regions›

section ‹Definition›

type_synonym 'c ceiling = "('c  nat)"

datatype intv =
  Const nat |
  Intv nat |
  Greater nat

datatype intv' =
  Const' int |
  Intv' int |
  Greater' int |
  Smaller' int

type_synonym t = real

instantiation real :: time
begin
  instance proof
    fix x y :: real
    assume "x < y" 
    then show "z>x. z < y" using dense_order_class.dense by blast 
  next
    have "(1 :: real)  0" by auto
    then show "x. (x::real)  0" ..
  qed
end

inductive valid_intv :: "nat  intv  bool"
where
  "0  d  d  c  valid_intv c (Const d)" |
  "0  d  d < c   valid_intv c (Intv d)" |
  "valid_intv c (Greater c)"

inductive valid_intv' :: "int  int  intv'  bool"
where
  "valid_intv' l _ (Smaller' (-l))" |
  "-l  d  d  u  valid_intv' l u (Const' d)" |
  "-l  d  d < u   valid_intv' l u (Intv' d)" |
  "valid_intv' _ u (Greater' u)"

inductive intv_elem :: "'c  ('c,t) cval  intv  bool"
where
  "u x = d  intv_elem x u (Const d)" |
  "d < u x  u x < d + 1  intv_elem x u (Intv d)" |
  "c < u x  intv_elem x u (Greater c)"

inductive intv'_elem :: "'c  'c  ('c,t) cval  intv'  bool"
where
  "u x - u y < c  intv'_elem x y u (Smaller' c)" |
  "u x - u y = d  intv'_elem x y u (Const' d)" |
  "d < u x - u y  u x - u y < d + 1  intv'_elem x y u (Intv' d)" |
  "c < u x - u y  intv'_elem x y u (Greater' c)"

abbreviation "total_preorder r  refl r  trans r"

inductive isConst :: "intv  bool"
where
  "isConst (Const _)"

inductive isIntv :: "intv  bool"
where
  "isIntv (Intv _)"

inductive isGreater :: "intv  bool"
where
  "isGreater (Greater _)"

declare isIntv.intros[intro!] isConst.intros[intro!] isGreater.intros[intro!]

declare isIntv.cases[elim!] isConst.cases[elim!] isGreater.cases[elim!]

inductive valid_region :: "'c set  ('c  nat)  ('c  intv)  ('c  'c  intv')  'c rel  bool"
where
  "X0 = {x  X.  d. I x = Intv d}; refl_on X0 r; trans r; total_on X0 r;  x  X. valid_intv (k x) (I x);
     x  X.  y  X. isGreater (I x)  isGreater (I y)  valid_intv' (k y) (k x) (J x y)
   valid_region X k I J r"

inductive_set region for X I J r
where
  " x  X. u x  0   x  X. intv_elem x u (I x)  X0 = {x  X.  d. I x = Intv d} 
    x  X0.  y  X0. (x, y)  r  frac (u x)  frac (u y) 
    x  X.  y  X. isGreater (I x)  isGreater (I y)  intv'_elem x y u (J x y)
   u  region X I J r"


text ‹Defining the unique element of a partition that contains a valuation›

definition part ("[_]⇩_" [61,61] 61) where "part v   THE R. R    v  R"

text ‹
  First we need to show that the set of regions is a partition of the set of all clock
  assignments. This property is only claimed by P. Bouyer.
›

inductive_cases[elim!]: "intv_elem x u (Const d)"
inductive_cases[elim!]: "intv_elem x u (Intv d)"
inductive_cases[elim!]: "intv_elem x u (Greater d)"
inductive_cases[elim!]: "valid_intv c (Greater d)"
inductive_cases[elim!]: "valid_intv c (Const d)"
inductive_cases[elim!]: "valid_intv c (Intv d)"
inductive_cases[elim!]: "intv'_elem x y u (Const' d)"
inductive_cases[elim!]: "intv'_elem x y u (Intv' d)"
inductive_cases[elim!]: "intv'_elem x y u (Greater' d)"
inductive_cases[elim!]: "intv'_elem x y u (Smaller' d)"
inductive_cases[elim!]: "valid_intv' l u (Greater' d)"
inductive_cases[elim!]: "valid_intv' l u (Smaller' d)"
inductive_cases[elim!]: "valid_intv' l u (Const' d)"
inductive_cases[elim!]: "valid_intv' l u (Intv' d)"

declare valid_intv.intros[intro]
declare valid_intv'.intros[intro]
declare intv_elem.intros[intro]
declare intv'_elem.intros[intro]

declare region.cases[elim]
declare valid_region.cases[elim]

section ‹Basic Properties›

text ‹First we show that all valid intervals are distinct›

lemma valid_intv_distinct:
  "valid_intv c I  valid_intv c I'  intv_elem x u I  intv_elem x u I'  I = I'"
by (cases I) (cases I', auto)+

lemma valid_intv'_distinct:
  "-c  d  valid_intv' c d I  valid_intv' c d I'  intv'_elem x y u I  intv'_elem x y u I'
   I = I'"
by (cases I) (cases I', auto)+

text ‹From this we show that all valid regions are distinct›

lemma valid_regions_distinct:
  "valid_region X k I J r  valid_region X k I' J' r'  v  region X I J r  v  region X I' J' r'
   region X I J r = region X I' J' r'"
proof goal_cases
  case 1
  note A = 1
  { fix x assume x: "x  X"
    with A(1) have "valid_intv (k x) (I x)" by auto
    moreover from A(2) x have "valid_intv (k x) (I' x)" by auto
    moreover from A(3) x have "intv_elem x v (I x)" by auto
    moreover from A(4) x have "intv_elem x v (I' x)" by auto
    ultimately have "I x = I' x" using valid_intv_distinct by fastforce
  } note * = this
  { fix x y assume x: "x  X" and y: "y  X" and B: "isGreater (I x)  isGreater (I y)"
    with * have C: "isGreater (I' x)  isGreater (I' y)" by auto
    from A(1) x y B have "valid_intv' (k y) (k x) (J x y)" by fastforce
    moreover from A(2) x y C have "valid_intv' (k y) (k x) (J' x y)" by fastforce
    moreover from A(3) x y B have "intv'_elem x y v (J x y)" by force
    moreover from A(4) x y C have "intv'_elem x y v (J' x y)" by force
    moreover from x y valid_intv'_distinct have "- int (k y)  int (k x)" by simp
    ultimately have "J x y = J' x y" by (blast intro: valid_intv'_distinct)
  } note ** = this
  from A show ?thesis
  proof (auto, goal_cases)
    case (1 u)
    note A = this
    { fix x assume x: "x  X"
      from A(5) x have "intv_elem x u (I x)" by auto
      with * x have "intv_elem x u (I' x)" by auto
    }
    then have " x  X. intv_elem x u (I' x)" by auto
    note B = this
    { fix x y assume x: "x  X" and y: "y  X" and B: "isGreater (I' x)  isGreater (I' y)"
      with * have "isGreater (I x)  isGreater (I y)" by auto
      with x y A(5) have "intv'_elem x y u (J x y)" by force
      with **[OF x y ‹isGreater (I x)  _] have "intv'_elem x y u (J' x y)" by simp
    } note C = this
    let ?X0 = "{x  X.  d. I' x = Intv d}"
    { fix x y assume x: "x  ?X0" and y: "y  ?X0"
      have "(x, y)  r'  frac (u x)  frac (u y)"
      proof
        assume "frac (u x)  frac (u y)"
        with A(5) x y * have "(x,y)  r" by auto
        with A(3) x y * have "frac (v x)  frac (v y)" by auto
        with A(4) x y   show "(x,y)  r'" by auto
      next
        assume "(x,y)  r'"
        with A(4) x y   have "frac (v x)  frac (v y)" by auto
        with A(3) x y * have "(x,y)  r" by auto
        with A(5) x y * show "frac (u x)  frac (u y)" by auto
      qed
    }
    then have *: " x  ?X0.  y  ?X0. (x, y)  r'  frac (u x)  frac (u y)" by auto
    from A(5) have "xX. 0  u x" by auto
    from region.intros[OF this B _ *] C show ?case by auto
  next
    case (2 u)
    note A = this
    { fix x assume x: "x  X"
      from A(5) x have "intv_elem x u (I' x)" by auto
      with * x have "intv_elem x u (I x)" by auto
    }
    then have " x  X. intv_elem x u (I x)" by auto
    note B = this
    { fix x y assume x: "x  X" and y: "y  X" and B: "isGreater (I x)  isGreater (I y)"
      with * have "isGreater (I' x)  isGreater (I' y)" by auto
      with x y A(5) have "intv'_elem x y u (J' x y)" by force
      with **[OF x y ‹isGreater (I x)  _] have "intv'_elem x y u (J x y)" by simp
    } note C = this
    let ?X0 = "{x  X.  d. I x = Intv d}"
    { fix x y assume x: "x  ?X0" and y: "y  ?X0"
      have "(x, y)  r  frac (u x)  frac (u y)"
      proof
        assume "frac (u x)  frac (u y)"
        with A(5) x y * have "(x,y)  r'" by auto
        with A(4) x y * have "frac (v x)  frac (v y)" by auto
        with A(3) x y   show "(x,y)  r" by auto
      next
        assume "(x,y)  r"
        with A(3) x y   have "frac (v x)  frac (v y)" by auto
        with A(4) x y * have "(x,y)  r'" by auto
        with A(5) x y * show "frac (u x)  frac (u y)" by auto
      qed
    }
    then have *:" x  ?X0.  y  ?X0. (x, y)  r  frac (u x)  frac (u y)" by auto
    from A(5) have "xX. 0  u x" by auto
    from region.intros[OF this B _ *] C show ?case by auto
  qed
qed

locale Beta_Regions =
  fixes X k  and V :: "('c, t) cval set"
  defines "  {region X I J r | I J r. valid_region X k I J r}"
  defines "V  {v .  x  X. v x  0}"
  assumes finite: "finite X"
  assumes non_empty: "X  {}"
begin

lemma ℛ_regions_distinct:
  "R  ; v  R; R'  ; R  R'  v  R'"
unfolding ℛ_def using valid_regions_distinct by blast

text ‹
  Secondly, we also need to show that every valuations belongs to a region which is part of
  the partition.
›

definition intv_of :: "nat  t  intv" where
  "intv_of c v 
    if (v > c) then Greater c
    else if ( x :: nat. x = v) then (Const (nat (floor v)))
    else (Intv (nat (floor v)))"

definition intv'_of :: "int  int  t  intv'" where
  "intv'_of l u v 
    if (v > u) then Greater' u
    else if (v < l) then Smaller' l
    else if ( x :: int. x = v) then (Const' (floor v))
    else (Intv' (floor v))"

lemma region_cover:
  " x  X. v x  0   R. R    v  R"
proof (standard, standard)
  assume assm: " x  X. 0  v x"
  let ?I = "λ x. intv_of (k x) (v x)"
  let ?J = "λ x y. intv'_of (-k y) (k x) (v x - v y)"
  let ?X0 = "{x  X.  d. ?I x = Intv d}"
  let ?r = "{(x,y). x  ?X0  y  ?X0  frac (v x)  frac (v y)}"
  { fix x y d assume A: "x  X" "y  X"
    then have "intv'_elem x y v (intv'_of (- int (k y)) (int (k x)) (v x - v y))" unfolding intv'_of_def
    proof (auto, goal_cases)
      case (1 a)
      then have "v x - v y = v x - v y" by (metis of_int_floor_cancel)
      then show ?case by auto
    next
      case 2
      then have "v x - v y < v x - v y" by (meson eq_iff floor_eq_iff not_less)
      with 2 show ?case by auto
    qed
  } note intro = this
  show "v  region X ?I ?J ?r"
  proof (standard, auto simp: assm intro: intro, goal_cases)
    case (1 x)
    thus ?case unfolding intv_of_def
    proof (auto, goal_cases)
      case (1 a)
      note A = this
      from A(2) have "v x = v x" by (metis floor_of_int of_int_of_nat_eq)
      with assm A(1) have "v x = real (nat v x)" by auto
      then show ?case by auto
    next
      case 2
      note A = this
      from A(1,2) have "real (nat v x) < v x"
      proof -
        have f1: "0  v x"
          using assm 1 by blast
        have "v x  real_of_int (int (nat v x))"
          by (metis (no_types) 2(2) of_int_of_nat_eq)
        then show ?thesis
          using f1 by linarith
      qed
      moreover from assm have "v x < real (nat (v x) + 1)" by linarith
      ultimately show ?case by auto
    qed
  qed
  { fix x y assume "x  X" "y  X"
    then have "valid_intv' (int (k y)) (int (k x)) (intv'_of (- int (k y)) (int (k x)) (v x - v y))"
    unfolding intv'_of_def
     apply auto
      apply (metis floor_of_int le_floor_iff linorder_not_less of_int_minus of_int_of_nat_eq valid_intv'.simps)
    by (metis floor_less_iff less_eq_real_def not_less of_int_minus of_int_of_nat_eq valid_intv'.intros(3))
  }
  moreover
  { fix x assume x: "x  X"
    then have "valid_intv (k x) (intv_of (k x) (v x))"
    proof (auto simp: intv_of_def, goal_cases)
      case (1 a)
      then show ?case
      by (intro valid_intv.intros(1)) (auto, linarith)
    next
      case 2
      then show ?case
      apply (intro valid_intv.intros(2))
      using assm floor_less_iff nat_less_iff by fastforce+
    qed
  }
  ultimately have "valid_region X k ?I ?J ?r"
  by (intro valid_region.intros, auto simp: refl_on_def trans_def total_on_def)
  then show "region X ?I ?J ?r  " unfolding ℛ_def by auto
qed

lemma region_cover_V: "v  V   R. R    v  R" using region_cover unfolding V_def by simp

text ‹
  Note that we cannot show that every region is non-empty anymore.
  The problem are regions fixing differences between an 'infeasible' constant.
›

text ‹
  We can show that there is always exactly one region a valid valuation belongs to.
  Note that we do not need non-emptiness for that.
›
lemma regions_partition:
  "x  X. 0  v x  ∃! R  . v  R"
proof goal_cases
  case 1
  note A = this
  with region_cover[OF ] obtain R where R: "R    v  R" by fastforce
  moreover 
  { fix R' assume "R'    v  R'"
   with R valid_regions_distinct[OF _ _ _ _] have "R' = R" unfolding ℛ_def by blast
  }
  ultimately show ?thesis by auto
qed

lemma region_unique:
  "v  R  R    [v]⇩ = R"
proof goal_cases
  case 1
  note A = this
  from A obtain I J r where *:
    "valid_region X k I J r" "R = region X I J r" "v  region X I J r"
  by (auto simp: ℛ_def)
  from this(3) have "xX. 0  v x" by auto
  from theI'[OF regions_partition[OF this]] obtain I' J' r' where
    v: "valid_region X k I' J' r'" "[v]⇩ = region X I' J' r'" "v  region X I' J' r'"
  unfolding part_def ℛ_def by auto
  from valid_regions_distinct[OF *(1) v(1) *(3) v(3)] v(2) *(2) show ?case by auto
qed

lemma regions_partition':
  "xX. 0  v x  xX. 0  v' x  v'  [v]⇩  [v']⇩ = [v]⇩"
proof goal_cases
  case 1
  note A = this
  from theI'[OF regions_partition[OF A(1)]] A(3) obtain I J r where
    v: "valid_region X k I J r" "[v]⇩ = region X I J r" "v'  region X I J r"
  unfolding part_def ℛ_def by blast
  from theI'[OF regions_partition[OF A(2)]] obtain I' J' r' where
    v': "valid_region X k I' J' r'" "[v']⇩ = region X I' J' r'" "v'  region X I' J' r'"
  unfolding part_def ℛ_def by auto
  from valid_regions_distinct[OF v'(1) v(1) v'(3) v(3)] v(2) v'(2) show ?case by simp
qed

lemma regions_closed:
  "R    v  R  t  0  [v  t]⇩  "
proof goal_cases
  case 1
  note A = this
  then obtain I J r where "v  region X I J r" unfolding ℛ_def by auto
  from this(1) have " x  X. v x  0" by auto
  with A(3) have " x  X. (v  t) x  0" unfolding cval_add_def by simp
  from regions_partition[OF this] obtain R' where "R'  " "(v  t)  R'" by auto
  with region_unique[OF this(2,1)] show ?case by auto
qed

lemma regions_closed':
  "R    v  R  t  0  (v  t)  [v  t]⇩"
proof goal_cases
  case 1
  note A = this
  then obtain I J r where "v  region X I J r" unfolding ℛ_def by auto
  from this(1) have " x  X. v x  0" by auto
  with A(3) have " x  X. (v  t) x  0" unfolding cval_add_def by simp
  from regions_partition[OF this] obtain R' where "R'  " "(v  t)  R'" by auto
  with region_unique[OF this(2,1)] show ?case by auto
qed

lemma valid_regions_I_cong:
  "valid_region X k I J r   x  X. I x = I' x
    x  X.  y  X. (isGreater (I x)  isGreater (I y))  J x y = J' x y
   region X I J r = region X I' J' r  valid_region X k I' J' r"
proof (auto, goal_cases)
  case (1 v)
  note A = this
  then have [simp]:
    " x. x  X  I' x = I x"
    " x y. x  X  y  X  isGreater (I x)  isGreater (I y)  J x y = J' x y"
  by metis+
  show ?case
  proof (standard, goal_cases)
    case 1 from A(4) show ?case by auto
  next
    case 2 from A(4) show ?case by auto
  next
    case 3 show "{x  X. d. I x = Intv d} = {x  X. d. I' x = Intv d}" by auto
  next
    case 4
    let ?X0 = "{x  X. d. I x = Intv d}"
    from A(4) show " x  ?X0.  y  ?X0. ((x, y)  r) = (frac (v x)  frac (v y))" by auto
  next
    case 5 from A(4) show ?case by force
  qed
next
  case (2 v)
  note A = this
  then have [simp]:
    " x. x  X  I' x = I x"
    " x y. x  X  y  X  isGreater (I x)  isGreater (I y)  J x y = J' x y"
  by metis+
  show ?case
  proof (standard, goal_cases)
    case 1 from A(4) show ?case by auto
  next
    case 2 from A(4) show ?case by auto
  next
    case 3
    show "{x  X. d. I' x = Intv d} = {x  X. d. I x = Intv d}" by auto
  next
    case 4
    let ?X0 = "{x  X. d. I' x = Intv d}"
    from A(4) show " x  ?X0.  y  ?X0. ((x, y)  r) = (frac (v x)  frac (v y))" by auto
  next
    case 5 from A(4) show ?case by force
  qed
next
  case 3
  note A = this
  then have [simp]:
    " x. x  X  I' x = I x"
    " x y. x  X  y  X  isGreater (I x)  isGreater (I y)  J x y = J' x y"
  by metis+
  show ?case
    apply rule
         apply (subgoal_tac "{x  X. d. I x = Intv d} = {x  X. d. I' x = Intv d}")
          apply assumption
  using A by force+
qed

fun intv_const :: "intv  nat"
where
  "intv_const (Const d) = d" |
  "intv_const (Intv d) = d"  |
  "intv_const (Greater d) = d"

fun intv'_const :: "intv'  int"
where
  "intv'_const (Smaller' d) = d" |
  "intv'_const (Const' d) = d" |
  "intv'_const (Intv' d) = d"  |
  "intv'_const (Greater' d) = d"

lemma finite_ℛ_aux:
  fixes P A B assumes "finite {x. A x}" "finite {x. B x}"
  shows "finite {(I, J) | I J. P I J r  A I  B J}"
using assms by (fastforce intro: pairwise_finiteI finite_ex_and1 finite_ex_and2)

lemma finite_ℛ:
  notes [[simproc add: finite_Collect]]
  shows "finite "
proof -
  { fix I J r assume A: "valid_region X k I J r"
    let ?X0 = "{x  X. d. I x = Intv d}"
    from A have "refl_on ?X0 r" by auto
    then have "r  X × X" by (auto simp: refl_on_def)
    then have "r  Pow (X × X)" by auto
  }
  then have "{r. I J. valid_region X k I J r}  Pow (X × X)" by auto
  from finite_subset[OF this] finite have fin: "finite {r. I J. valid_region X k I J r}" by auto
  let ?u = "Max {k x | x. x  X}"
  let ?l = "- Max {k x | x. x  X}"
  let ?I = "{intv. intv_const intv  ?u}"
  let ?J = "{intv. ?l  intv'_const intv  intv'_const intv  ?u}"
  let ?S = "{r. I J. valid_region X k I J r}"
  let ?fin_mapI = "λ I. x. (x  X  I x  ?I)  (x  X  I x = Const 0)"
  let ?fin_mapJ = "λ J. x. y. (x  X  y  X  J x y  ?J)
                               (x  X  J x y = Const' 0)  (y  X  J x y = Const' 0)"
  let ?ℛ = "{region X I J r | I J r. valid_region X k I J r  ?fin_mapI I  ?fin_mapJ J}"
  let ?f = "λr. {region X I J r | I J . valid_region X k I J r  ?fin_mapI I  ?fin_mapJ J}"
  let ?g = "λr. {(I, J) | I J . valid_region X k I J r  ?fin_mapI I  ?fin_mapJ J}"
  have "?I = (Const ` {d. d  ?u})  (Intv ` {d. d  ?u})  (Greater ` {d. d  ?u})"
  by auto (case_tac x, auto)
  then have "finite ?I" by auto
  from finite_set_of_finite_funs[OF ‹finite X this] have finI: "finite {I. ?fin_mapI I}" .
  have "?J = (Smaller' ` {d. ?l  d  d  ?u})  (Const' ` {d. ?l  d  d  ?u})
            (Intv' ` {d. ?l  d  d  ?u})  (Greater' ` {d. ?l  d  d  ?u})"
  by auto (case_tac x, auto)
  then have "finite ?J" by auto
  from finite_set_of_finite_funs2[OF ‹finite X ‹finite X this] have finJ: "finite {J. ?fin_mapJ J}" .
  from finite_ℛ_aux[OF finI finJ, of "valid_region X k"] have "r  ?S. finite (?g r)" by simp
  moreover have " r  ?S. ?f r = (λ (I, J). region X I J r) ` ?g r" by auto
  ultimately have "r  ?S. finite (?f r)" by auto
  moreover have "?ℛ =  (?f `?S)" by auto
  ultimately have "finite ?ℛ" using fin by auto
  moreover have "  ?ℛ"
  proof
    fix R assume R: "R  "
    then obtain I J r where I: "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
    let ?I = "λ x. if x  X then I x else Const 0"
    let ?J = "λ x y. if x  X  y  X  (isGreater (I x)  isGreater (I y)) then J x y else Const' 0"
    let ?R = "region X ?I ?J r"
    from valid_regions_I_cong[OF I(2)] I have *: "R = ?R" "valid_region X k ?I ?J r" by auto
    have "x. x  X  ?I x = Const 0" by auto
    moreover have "x. x  X  intv_const (I x)  ?u"
    proof auto
      fix x assume x: "x  X"
      with I(2) have "valid_intv (k x) (I x)" by auto
      moreover from ‹finite X x have "k x  ?u" by (auto intro: Max_ge)
      ultimately  show "intv_const (I x)  Max {k x |x. x  X}" by (cases "I x") auto
    qed
    ultimately have **: "?fin_mapI ?I" by auto
    have "x y. x  X  ?J x y = Const' 0" by auto
    moreover have "x y. y  X  ?J x y = Const' 0" by auto
    moreover have "x.  y. x  X  y  X  ?l  intv'_const (?J x y)  intv'_const (?J x y)  ?u"
    proof clarify
      fix x y assume x: "x  X" assume y: "y  X"
      show "?l  intv'_const (?J x y)  intv'_const (?J x y)  ?u"
      proof (cases "isGreater (I x)  isGreater (I y)")
        case True
        with x y I(2) have "valid_intv' (k y) (k x) (J x y)" by fastforce
        moreover from ‹finite X x have "k x  ?u" by (auto intro: Max_ge)
        moreover from ‹finite X y have "?l  -k y" by (auto intro: Max_ge)
        ultimately show ?thesis by (cases "J x y") auto
      next
        case False then show ?thesis by auto
      qed
    qed
    ultimately have "?fin_mapJ ?J" by auto
    with * ** show "R  ?ℛ" by blast
  qed
  ultimately show "finite " by (blast intro: finite_subset)
qed

end

section ‹Approximation with β›-regions›

locale Beta_Regions' = Beta_Regions +
  fixes v n not_in_X
  assumes clock_numbering: " c. v c > 0  (x. y. v x  n  v y  n  v x = v y  x = y)"
                           "k :: nat n. k > 0  (c  X. v c = k)" " c  X. v c  n"
  assumes not_in_X: "not_in_X  X"
begin

definition "v'  λ i. if i  n then (THE c. c  X  v c = i) else not_in_X"

lemma v_v':
  " c  X. v' (v c) = c"
using clock_numbering unfolding v'_def by auto

abbreviation
  "vabstr (S :: ('a, t) zone) M  S = [M]v,n  ( in.  jn. M i j    get_const (M i j)  )"

definition normalized:
  "normalized M 
    ( i j. 0 < i  i  n  0 < j  j  n  M i j   
       Lt (- ((k o v') j))  M i j  M i j  Le ((k o v') i))
     ( i  n. i > 0  (M i 0  Le ((k o v') i)  M i 0 = )  Lt (- ((k o v') i))  M 0 i)"

definition apx_def:
  "Approxβ Z   {S.  U M. S =  U  U    Z  S  vabstr S M  normalized M}"

lemma apx_min:
  "S =  U  U    S = [M]v,n   in.  jn. M i j    get_const (M i j)  
   normalized M  Z  S  Approxβ Z  S"
unfolding apx_def by blast

lemma "U  {}  x   U   S  U. x  S" by auto

lemma ℛ_union: "  = V" using region_cover unfolding V_def ℛ_def by auto

lemma all_dbm: " M. vabstr () M  normalized M"
proof -
  let ?M = "λ i j. if i = 0 then Le 0 else "
  have "[?M]v,n = V" unfolding V_def DBM_zone_repr_def DBM_val_bounded_def
  proof (auto, goal_cases)
    case (1 u c)
    with clock_numbering have "dbm_entry_val u None (Some c) (Le 0)" by auto
    then show ?case by auto
  next
    case (2 u c)
    from clock_numbering(1) have "0  v c" by auto
    with 2 show ?case by auto 
  next
    case (3 u c)
    from clock_numbering(1) have "0  v c" by auto
    with 3 show ?case by auto 
  next
    case (4 u c)
    with clock_numbering have "c  X" by blast
    with 4(1) show ?case by auto
  next
    case (5 u c1)
    from clock_numbering(1) have "0  v c1" by auto
    with 5 show ?case by auto
  qed
  moreover have " in.  jn. ?M i j    get_const (?M i j)  " by auto
  moreover have "normalized ?M" unfolding normalized less_eq dbm_le_def by auto
  ultimately show ?thesis using ℛ_union by auto
qed

lemma ℛ_int:
  "R    R'    R  R'  R  R' = {}" using ℛ_regions_distinct by blast

lemma aux1:
  "u  R  R    U    u   U  R   U" using ℛ_int by blast

lemma aux2: "x   U  U  {}   S  U. x  S" by blast

lemma aux2': "x   U  U  {}   S  U. x  S" by blast

lemma apx_subset: "Z  Approxβ Z" unfolding apx_def by auto

lemma aux3:
  " X  U.  Y  U. X  Y  U  S  U  S  {}  finite S   S  U"
proof goal_cases
  case 1
  with finite_list obtain l where "set l = S" by blast
  then show ?thesis using 1
  proof (induction l arbitrary: S)
    case Nil thus ?case by auto
  next
    case (Cons x xs)
    show ?case
    proof (cases "set xs = {}")
      case False
      with Cons have "(set xs)  U" by auto
      with Cons.prems(1-3) show ?thesis by force
    next
      case True
      with Cons.prems show ?thesis by auto
    qed
  qed
qed

lemma empty_zone_dbm:
  " M :: t DBM. vabstr {} M  normalized M  (k  n. M k k  Le 0)"
proof -
  from non_empty obtain c where c: "c  X" by auto
  with clock_numbering have c': "v c > 0" "v c  n" by auto
  let ?M = "λi j. if i = v c  j = 0  i = j then Le (0::t) else if i = 0  j = v c then Lt 0 else "
  have "[?M]v,n = {}" unfolding DBM_zone_repr_def DBM_val_bounded_def using c' by auto
  moreover have " in.  jn. ?M i j    get_const (?M i j)  " by auto
  moreover have "normalized ?M" unfolding normalized less_eq dbm_le_def by auto
  ultimately show ?thesis by auto
qed

lemma valid_dbms_int:
  "X{S. M. vabstr S M}. Y{S. M. vabstr S M}. X  Y  {S. M. vabstr S M}"
proof (auto, goal_cases)
  case (1 M1 M2)
  obtain M' where M': "M' = And M1 M2" by fast
  from DBM_and_sound1[OF ] DBM_and_sound2[OF] DBM_and_complete[OF ]
  have "[M1]v,n  [M2]v,n = [M']v,n" unfolding DBM_zone_repr_def M' by auto
  moreover from 1 have " in.  jn. M' i j    get_const (M' i j)  "
  unfolding M' by (auto split: split_min)
  ultimately show ?case by auto
qed

print_statement split_min

lemma split_min':
  "P (min i j) = ((min i j = i  P i)  (min i j = j  P j))"
unfolding min_def by auto

lemma normalized_and_preservation:
  "normalized M1  normalized M2  normalized (And M1 M2)"
unfolding normalized by safe (subst And.simps, split split_min', fastforce)+

lemma valid_dbms_int':
  "X{S. M. vabstr S M  normalized M}. Y{S. M. vabstr S M  normalized M}.
    X  Y  {S. M. vabstr S M  normalized M}"
proof (auto, goal_cases)
  case (1 M1 M2)
  obtain M' where M': "M' = And M1 M2" by fast
  from DBM_and_sound1 DBM_and_sound2 DBM_and_complete
  have "[M1]v,n  [M2]v,n = [M']v,n" unfolding M' DBM_zone_repr_def by auto
  moreover from M' 1 have " in.  jn. M' i j    get_const (M' i j)  "
  by (auto split: split_min)
  moreover from normalized_and_preservation[OF 1(2,4)] have "normalized M'" unfolding M' .
  ultimately show ?case by auto
qed

lemma apx_in:
  "Z  V  Approxβ Z  {S.  U M. S =  U  U    Z  S  vabstr S M  normalized M}"
proof -
  assume "Z  V"
  let ?A = "{S.  U M. S =  U  U    Z  S  vabstr S M  normalized M}"
  let ?U = "{R  .  S  ?A. R  S}"
  have "?A  {S.  U. S =  U  U  }" by auto
  moreover from finite_ℛ have "finite " by auto
  ultimately have "finite ?A" by (auto intro: finite_subset)
  from all_dbm obtain M where M:
    "vabstr () M" "normalized M"
  by auto
  with _  V ℛ_union have "V  ?A" by blast
  then have "?A  {}" by blast
  have "?A  {S.  M. vabstr S M  normalized M}" by auto
  with aux3[OF valid_dbms_int' this ?A  _ ‹finite ?A] have
    " ?A  {S.  M. vabstr S M  normalized M}"
  by blast
  then obtain M where *: "vabstr (Approxβ Z) M" "normalized M" unfolding apx_def by auto
  have " ?U =  ?A"
  proof (safe, goal_cases)
    case 1
    show ?case
    proof (cases "Z = {}")
      case False
      then obtain v where "v  Z" by auto
      with region_cover Z  V obtain R where "R  " "v  R" unfolding V_def by blast
      with aux1[OF this(2,1)] v  Z have "R  ?U" by blast
      with 1 show ?thesis by blast
    next
      case True
      with empty_zone_dbm have "{}  ?A" by auto
      with 1(1,3) show ?thesis by blast
    qed
  next
    case (2 v)
    from aux2[OF 2 ?A  _] obtain S where "v  S" "S  ?A" by blast
    then obtain R where "v  R" "R  " by auto
    { fix S assume "S  ?A"
      with aux2'[OF 2 ?A  _] have "v  S" by auto
      with S  ?A obtain U M R' where *:
        "v  R'" "R'  " "S = U" "U  " "vabstr S M" "Z  S"
      by blast
      from aux1[OF this(1,2,4)] *(3) v  S have "R'  S" by blast
      moreover from ℛ_regions_distinct[OF *(2,1) R  ] v  R have "R' = R" by fast
      ultimately have "R  S" by fast
    }
    with R   have "R  ?U" by auto
    with v  R show ?case by auto
  qed
  then have "Approxβ Z = ?U" "?U  " "Z  Approxβ Z" unfolding apx_def by auto
  with * show ?thesis by blast
qed

lemma apx_empty:
  "Approxβ {} = {}"
unfolding apx_def using empty_zone_dbm by blast

end

section ‹Computing β›-Approximation›

context Beta_Regions'
begin

lemma dbm_regions:
  "vabstr S M  normalized M  [M]v,n  {}  [M]v,n  V   U  . S =  U"
proof goal_cases
  case A: 1
  let ?U =
    "{R  .  I J r. R = region X I J r  valid_region X k I J r 
      ( c  X.
        ( d. I c = Const d  M (v c) 0  Le d  M 0 (v c)  Le (-d)) 
        ( d. I c = Intv d   M (v c) 0  Lt (d + 1)  M 0 (v c)  Lt (-d))  
        (I c = Greater (k c)   M (v c) 0 = )
      ) 
      ( x  X.  y  X.
        ( c d. I x = Intv c  I y = Intv d  M (v x) (v y) 
          (if (x, y)  r then if (y, x)  r then Le (c - d) else Lt (c - d) else Lt (c - d + 1))) 
        ( c d. I x = Intv c  I y = Intv d  M (v y) (v x) 
          (if (y, x)  r then if (x, y)  r then Le (d - c) else Lt (d - c) else Lt (d - c + 1))) 
        ( c d. I x = Const c  I y = Const d  M (v x) (v y)  Le (c - d)) 
        ( c d. I x = Const c  I y = Const d  M (v y) (v x)  Le (d - c)) 
        ( c d. I x = Intv c  I y = Const d  M (v x) (v y)  Lt (c - d + 1)) 
        ( c d. I x = Intv c  I y = Const d  M (v y) (v x)  Lt (d - c)) 
        ( c d. I x = Const c  I y = Intv d  M (v x) (v y)  Lt (c - d)) 
        ( c d. I x = Const c  I y = Intv d  M (v y) (v x)  Lt (d - c + 1)) 
        ((isGreater (I x)  isGreater (I y))  J x y = Greater' (k x)  M (v x) (v y) = ) 
        ( c. (isGreater (I x)  isGreater (I y))  J x y = Const' c
           M (v x) (v y)  Le c  M (v y) (v x)  Le (- c)) 
        ( c. (isGreater (I x)  isGreater (I y))  J x y = Intv' c
           M (v x) (v y)  Lt (c + 1)  M (v y) (v x)  Lt (- c))
      )
     }"
  have " ?U = [M]v,n" unfolding DBM_zone_repr_def DBM_val_bounded_def
  proof (standard, goal_cases)
    case 1
    show ?case
    proof (auto, goal_cases)
      case 1
      from A(3) show "Le 0  M 0 0" unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
    next
      case (2 u I J r c)
      note B = this
      from B(6) clock_numbering have "c  X" by blast
      with B(1) v_v' have *: "intv_elem c u (I c)" "v' (v c) = c" by auto
      from clock_numbering(1) have "v c > 0" by auto
      show ?case
      proof (cases "I c")
        case (Const d)
        with B(4) c  X have "M 0 (v c)  Le (- real d)" by auto
        with * Const show ?thesis by - (rule dbm_entry_val_mono_2[folded less_eq], auto)
      next
        case (Intv d)
        with B(4) c  X have "M 0 (v c)  Lt (- real d)" by auto
        with * Intv show ?thesis by - (rule dbm_entry_val_mono_2[folded less_eq], auto)
      next
        case (Greater d)
        with B(3) c  X have "I c = Greater (k c)" by fastforce
        with * have "- u c < - k c" by auto
        moreover from A(2) *(2) v c  n v c > 0 have
          "Lt (- k c)  M 0 (v c)"
        unfolding normalized by force
        ultimately show ?thesis by - (rule dbm_entry_val_mono_2[folded less_eq], auto)
      qed
    next
      case (3 u I J r c)
      note B = this
      from B(6) clock_numbering have "c  X" by blast
      with B(1) v_v' have *: "intv_elem c u (I c)" "v' (v c) = c" by auto
      from clock_numbering(1) have "v c > 0" by auto
      show ?case
      proof (cases "I c")
        case (Const d)
        with B(4) c  X have "M (v c) 0  Le d" by auto
        with * Const show ?thesis by - (rule dbm_entry_val_mono_3[folded less_eq], auto)
      next
        case (Intv d)
        with B(4) c  X have "M (v c) 0  Lt (real d + 1)" by auto
        with * Intv show ?thesis by - (rule dbm_entry_val_mono_3[folded less_eq], auto)
      next
        case (Greater d)
        with B(3) c  X have "I c = Greater (k c)" by fastforce
        with B(4) c  X show ?thesis by auto
      qed
    next
      case B: (4 u I J r c1 c2)
      from B(6,7) clock_numbering have "c1  X" "c2  X" by blast+
      with B(1) v_v' have *:
        "intv_elem c1 u (I c1)" "intv_elem c2 u (I c2)" "v' (v c1) = c1" "v' (v c2) = c2"
      by auto
      from clock_numbering(1) have "v c1 > 0" "v c2 > 0" by auto
      { assume C: "isGreater (I c1)  isGreater (I c2)"
        with B(1) c1  X c2  X have **: "intv'_elem c1 c2 u (J c1 c2)" by force
        have ?case
        proof (cases "J c1 c2")
          case (Smaller' c)
          with C B(3) c1  X c2  X have "c  - k c2" by fastforce
          moreover from C c1  X c2  X ** Smaller' have "u c1 - u c2 < c" by auto
          moreover from A(2) *(3,4) B(6,7) v c1 > 0 v c2 > 0 have
            "M (v c1) (v c2)  Lt (- k c2)  M (v c1) (v c2) = "
          unfolding normalized by fastforce
          ultimately show ?thesis by (safe) (rule dbm_entry_val_mono_1[folded less_eq], auto)
        next
          case (Const' c)
          with C B(5) c1  X c2  X have "M (v c1) (v c2)  Le c" by auto
          with Const' ** c1  X c2  X show ?thesis
          by (auto intro: dbm_entry_val_mono_1[folded less_eq])
        next
          case (Intv' c)
          with C B(5) c1  X c2  X have "M (v c1) (v c2)  Lt (real_of_int c + 1)" by auto
          with Intv' ** c1  X c2  X show ?thesis
          by (auto intro: dbm_entry_val_mono_1[folded less_eq])
        next
          case (Greater' c)
          with C B(3) c1  X c2  X have "c = k c1" by fastforce
          with Greater' C B(5) c1  X c2  X show ?thesis by auto
        qed
      } note GreaterI = this
      show ?case
      proof (cases "I c1")
        case (Const c)
        show ?thesis
        proof (cases "I c2", goal_cases)
          case (1 d)
          with Const c1  X c2  X *(1,2) have "u c1 = c" "u c2 = d" by auto
          moreover from c1  X c2  X 1 Const B(5) have
            "Le (real c - real d)  M (v c1) (v c2)"
          by meson
          ultimately show ?thesis by (auto intro: dbm_entry_val_mono_1[folded less_eq])
        next
          case (Intv d)
          with Const c1  X c2  X *(1,2) have "u c1 = c" "d < u c2" by auto
          then have "u c1 - u c2 < c - real d" by auto
          moreover from Const c1  X c2  X Intv B(5) have
            "Lt (real c - d)  M (v c1) (v c2)"
          by meson
          ultimately show ?thesis by (auto intro: dbm_entry_val_mono_1[folded less_eq])
        next
          case Greater then show ?thesis by (auto intro: GreaterI)
        qed
      next
        case (Intv c)
        show ?thesis
        proof (cases "I c2", goal_cases)
          case (Const d)
          with Intv c1  X c2  X *(1,2) have "u c1 < c + 1" "d = u c2" by auto
          then have "u c1 - u c2 < c - real d + 1" by auto
          moreover from c1  X c2  X Intv Const B(5) have
            "Lt (real c - real d + 1)  M (v c1) (v c2)"
          by meson
          ultimately show ?thesis by (auto intro: dbm_entry_val_mono_1[folded less_eq])
        next
          case (2 d)
          show ?case
          proof (cases "(c1,c2)  r")
            case True
            note T = this
            show ?thesis
            proof (cases "(c2,c1)  r")
              case True
              with T B(5) 2 Intv c1  X c2  X have
                "Le (real c - real d)  M (v c1) (v c2)"
              by auto
              moreover from nat_intv_frac_decomp[of c "u c1"] nat_intv_frac_decomp[of d "u c2"]
                            B(1,2) c1  X c2  X T True Intv 2 *(1,2)
              have "u c1 - u c2 = real c - d" by auto
              ultimately show ?thesis by (auto intro: dbm_entry_val_mono_1[folded less_eq])
            next
              case False
              with T B(5) 2 Intv c1  X c2  X have
                "Lt (real c - real d)  M (v c1) (v c2)"
              by auto
              moreover from nat_intv_frac_decomp[of c "u c1"] nat_intv_frac_decomp[of d "u c2"]
                            B(1,2) c1  X c2  X T False Intv 2 *(1,2)
              have "u c1 - u c2 < real c - d" by auto
              ultimately show ?thesis by (auto intro: dbm_entry_val_mono_1[folded less_eq])
            qed
          next
            case False
            with B(5) 2 Intv c1  X c2  X have
                "Lt (real c - real d + 1)  M (v c1) (v c2)"
            by meson
            moreover from 2 Intv c1  X c2  X * have "u c1 - u c2 < c - real d + 1" by auto
            ultimately show ?thesis by (auto intro: dbm_entry_val_mono_1[folded less_eq])
          qed
        next
          case Greater then show ?thesis by (auto intro: GreaterI)
        qed
      next
        case Greater then show ?thesis by (auto intro: GreaterI)
      qed
    qed
  next
    case 2 show ?case
    proof (safe, goal_cases)
      case (1 u)
      with A(4) have "u  V" unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
      with region_cover obtain R where "R  " "u  R" unfolding V_def by auto
      then obtain I J r where R: "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
      have "(cX. (d. I c = Const d  Le (real d)  M (v c) 0  Le (- real d)  M 0 (v c)) 
                 (d. I c = Intv d  Lt (real d + 1)  M (v c) 0  Lt (- real d)  M 0 (v c)) 
                 (I c = Greater (k c)  M (v c) 0 = ))"
      proof safe
        fix c assume "c  X"
        with R u  R have *: "intv_elem c u (I c)" by auto
        fix d assume **: "I c = Const d"
        with * have "u c = d" by fastforce
        moreover from ** clock_numbering(3) c  X 1 have
          "dbm_entry_val u (Some c) None (M (v c) 0)"
        by auto
        ultimately show "Le (real d)  M (v c) 0"
        unfolding less_eq dbm_le_def by (cases "M (v c) 0") auto
      next
        fix c assume "c  X"
        with R u  R have *: "intv_elem c u (I c)" by auto
        fix d assume **: "I c = Const d"
        with * have "u c = d" by fastforce
        moreover from ** clock_numbering(3) c  X 1 have
          "dbm_entry_val u None (Some c) (M 0 (v c))"
        by auto
        ultimately show "Le (- real d)  M 0 (v c)"
        unfolding less_eq dbm_le_def by (cases "M 0 (v c)") auto
      next
        fix c assume "c  X"
        with R u  R have *: "intv_elem c u (I c)" by auto
        fix d assume **: "I c = Intv d"
        with * have "d < u c" "u c < d + 1" by fastforce+
        moreover from ** clock_numbering(3) c  X 1 have
          "dbm_entry_val u (Some c) None (M (v c) 0)"
        by auto
        moreover have
          "M (v c) 0    get_const (M (v c) 0)  "
        using c  X clock_numbering A(1) by auto
        ultimately show "Lt (real d + 1)  M (v c) 0" unfolding less_eq dbm_le_def
        apply (cases "M (v c) 0")
          apply auto
         apply (rename_tac x1)
         apply (subgoal_tac "x1 > d")
          apply (rule dbm_lt.intros(5))
          apply (metis nat_intv_frac_gt0 frac_eq_0_iff less_irrefl linorder_not_le of_nat_1 of_nat_add)
         apply simp
        apply (rename_tac x2)
        apply (subgoal_tac "x2 > d + 1")
         apply (rule dbm_lt.intros(6))
         apply (metis of_nat_1 of_nat_add)
        apply simp
        by (metis nat_intv_not_int One_nat_def add.commute add.right_neutral add_Suc_right le_less_trans
                  less_eq_real_def linorder_neqE_linordered_idom semiring_1_class.of_nat_simps(2))
      next
        fix c assume "c  X"
        with R u  R have *: "intv_elem c u (I c)" by auto
        fix d assume **: "I c = Intv d"
        with * have "d < u c" "u c < d + 1" by fastforce+
        moreover from ** clock_numbering(3) c  X 1 have
          "dbm_entry_val u None (Some c) (M 0 (v c))"
        by auto
        moreover have "M 0 (v c)    get_const (M 0 (v c))  " using c  X clock_numbering A(1) by auto
        ultimately show "Lt (- real d)  M 0 (v c)" unfolding less_eq dbm_le_def
          proof (cases "M 0 (v c)", -, auto, goal_cases)
            case prems: (1 x1)
            then have "u c = d + frac (u c)" by (metis nat_intv_frac_decomp u c < d + 1) 
            with prems(5) have "- x1  d + frac (u c)" by auto
            with prems(1) frac_ge_0 frac_lt_1 have "- x1  d"
            by - (rule ints_le_add_frac2[of "frac (u c)" d "-x1"]; fastforce)
            with prems have "- d  x1" by auto
            then show ?case by auto
          next
            case prems: (2 x1)
            then have "u c = d + frac (u c)" by (metis nat_intv_frac_decomp u c < d + 1) 
            with prems(5) have "- x1  d + frac (u c)" by auto
            with prems(1) frac_ge_0 frac_lt_1 have "- x1  d"
            by - (rule ints_le_add_frac2[of "frac (u c)" d "-x1"]; fastforce)
            with prems(6) have "- d < x1" by auto
            then show ?case by auto
        qed
      next
        fix c assume "c  X"
        with R u  R have *: "intv_elem c u (I c)" by auto
        fix d assume **: "I c = Greater (k c)"
        have "M (v c) 0  Le ((k o v') (v c))  M (v c) 0 = "
        using A(2) c  X clock_numbering unfolding normalized by auto
        with v_v' c  X have "M (v c) 0  Le (k c)  M (v c) 0 = " by auto
        moreover from * ** have "k c < u c" by fastforce
        moreover from ** clock_numbering(3) c  X 1 have
          "dbm_entry_val u (Some c) None (M (v c) 0)"
        by auto
        moreover have
          "M (v c) 0    get_const (M (v c) 0)  "
        using c  X clock_numbering A(1) by auto
        ultimately show "M (v c) 0 = " unfolding less_eq dbm_le_def
          apply -
          apply (rule ccontr)
          using ** apply (cases "M (v c) 0")
        by auto
      qed
      moreover
      { fix x y assume X: "x  X" "y  X"
        with R u  R have *: "intv_elem x u (I x)" "intv_elem y u (I y)" by auto
        from X R u  R have **:
          "isGreater (I x)  isGreater (I y)  intv'_elem x y u (J x y)"
        by force
        have int: "M (v x) (v y)    get_const (M (v x) (v y))  " using X clock_numbering A(1)
        by auto
        have int2: "M (v y) (v x)    get_const (M (v y) (v x))  " using X clock_numbering A(1)
        by auto
        from 1 clock_numbering(3) X 1 have ***:
          "dbm_entry_val u (Some x) (Some y) (M (v x) (v y))"
          "dbm_entry_val u (Some y) (Some x) (M (v y) (v x))"
        by auto
        have
         "( c d. I x = Intv c  I y = Intv d  M (v x) (v y) 
            (if (x, y)  r then if (y, x)  r then Le (c - d) else Lt (c - d) else Lt (c - d + 1))) 
          ( c d. I x = Intv c  I y = Intv d  M (v y) (v x) 
            (if (y, x)  r then if (x, y)  r then Le (d - c) else Lt (d - c) else Lt (d - c + 1))) 
          ( c d. I x = Const c  I y = Const d  M (v x) (v y)  Le (c - d)) 
          ( c d. I x = Const c  I y = Const d  M (v y) (v x)  Le (d - c)) 
          ( c d. I x = Intv c  I y = Const d  M (v x) (v y)  Lt (c - d + 1)) 
          ( c d. I x = Intv c  I y = Const d  M (v y) (v x)  Lt (d - c)) 
          ( c d. I x = Const c  I y = Intv d  M (v x) (v y)  Lt (c - d)) 
          ( c d. I x = Const c  I y = Intv d  M (v y) (v x)  Lt (d - c + 1)) 
          ((isGreater (I x)  isGreater (I y))  J x y = Greater' (k x)  M (v x) (v y) = ) 
          ( c. (isGreater (I x)  isGreater (I y))  J x y = Const' c
             M (v x) (v y)  Le c  M (v y) (v x)  Le (- c)) 
          ( c. (isGreater (I x)  isGreater (I y))  J x y = Intv' c
             M (v x) (v y)  Lt (c + 1)  M (v y) (v x)  Lt (- c))"
        proof (auto, goal_cases)
          case **: (1 c d)
          with R u  R X have "frac (u x) = frac (u y)" by auto
          with * ** nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
            "u x - u y = real c - d"
          by auto
          with *** show ?case unfolding less_eq dbm_le_def by (cases "M (v x) (v y)") auto
        next
          case **: (2 c d)
          with R u  R X have "frac (u x) > frac (u y)" by auto
          with * ** nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
            "real c - d < u x - u y" "u x - u y < real c - d + 1"
          by auto
          with *** int show ?case unfolding less_eq dbm_le_def
          by (cases "M (v x) (v y)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
        next
          case **: (3 c d)
          from ** R u  R X have "frac (u x) < frac (u y)" by auto
          with * ** nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
            "real c - d - 1 < u x - u y" "u x - u y < real c - d"
          by auto
          with *** int show ?case unfolding less_eq dbm_le_def
          by (cases "M (v x) (v y)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
        next
          case (4 c d) with R(1) u  R X show ?case by auto
        next
          case **: (5 c d)
          with R u  R X have "frac (u x) = frac (u y)" by auto
          with * ** nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
            "u x - u y = real c - d" by auto
          with *** show ?case unfolding less_eq dbm_le_def by (cases "M (v y) (v x)") auto
        next
          case **: (6 c d)
          from ** R u  R X have "frac (u x) < frac (u y)" by auto
          with * ** nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
            "real d - c < u y - u x" "u y - u x < real d - c + 1"
          by auto
          with *** int2 show ?case unfolding less_eq dbm_le_def
          by (cases "M (v y) (v x)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
        next
          case **: (7 c d)
          from ** R u  R X have "frac (u x) > frac (u y)" by auto
          with * ** nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
            "real d - c - 1 < u y - u x" "u y - u x < real d - c"
          by auto
          with *** int2 show ?case unfolding less_eq dbm_le_def
          by (cases "M (v y) (v x)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
        next
          case (8 c d) with R(1) u  R X show ?case by auto
        next
          case (9 c d)
          with * nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have 
            "u x - u y = real c - d" by auto
          with *** show ?case unfolding less_eq dbm_le_def by (cases "M (v x) (v y)") auto
        next
          case (10 c d)
          with * nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
            "u x - u y = real c - d"
          by auto
          with *** show ?case unfolding less_eq dbm_le_def by (cases "M (v y) (v x)") auto
        next
          case (11 c d)
          with * nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
            "real c - d < u x - u y"
          by auto
          with *** int show ?case unfolding less_eq dbm_le_def
          by (cases "M (v x) (v y)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
        next
          case (12 c d)
          with * nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
            "real d - c - 1 < u y - u x"
          by auto
          with *** int2 show ?case unfolding less_eq dbm_le_def
          by (cases "M (v y) (v x)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
        next
          case (13 c d)
          with * nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
            "real c - d - 1 < u x - u y"
          by auto
          with *** int show ?case unfolding less_eq dbm_le_def
          by (cases "M (v x) (v y)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
        next
          case (14 c d)
          with * nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
            "real d - c < u y - u x"
          by auto
          with *** int2 show ?case unfolding less_eq dbm_le_def
          by (cases "M (v y) (v x)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
        next
          case (15 d)
          have "M (v x) (v y)  Le ((k o v') (v x))  M (v x) (v y) = "
          using A(2) X clock_numbering unfolding normalized by auto
          with v_v' X have "M (v x) (v y)  Le (k x)  M (v x) (v y) = " by auto
          moreover from 15 * ** have "u x - u y > k x" by auto
          ultimately show ?case unfolding less_eq dbm_le_def using *** by (cases "M (v x) (v y)", auto)
        next
          case (16 d)
          have "M (v x) (v y)  Le ((k o v') (v x))  M (v x) (v y) = "
          using A(2) X clock_numbering unfolding normalized by auto
          with v_v' X have "M (v x) (v y)  Le (k x)  M (v x) (v y) = " by auto
          moreover from 16 * ** have "u x - u y > k x" by auto
          ultimately show ?case unfolding less_eq dbm_le_def using *** by (cases "M (v x) (v y)", auto)
        next
          case 17 with ** *** show ?case unfolding less_eq dbm_le_def by (cases "M (v x) (v y)", auto)
        next
          case 18 with ** *** show ?case unfolding less_eq dbm_le_def by (cases "M (v y) (v x)", auto)
        next
          case 19 with ** *** show ?case unfolding less_eq dbm_le_def by (cases "M (v x) (v y)", auto)
        next
          case 20 with ** *** show ?case unfolding less_eq dbm_le_def by (cases "M (v y) (v x)", auto)
        next
          case (21 c d)
          with ** have "c < u x - u y" by auto
          with *** int show ?case unfolding less_eq dbm_le_def
          by (cases "M (v x) (v y)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
        next
          case (22 c d)
          with ** have "u x - u y < c + 1" by auto
          then have "u y - u x > - c - 1" by auto
          with *** int2 show ?case unfolding less_eq dbm_le_def
          by (cases "M (v y) (v x)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
        next
          case (23 c d)
          with ** have "c < u x - u y" by auto
          with *** int show ?case unfolding less_eq dbm_le_def
          by (cases "M (v x) (v y)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
        next
          case (24 c d)
          with ** have "u x - u y < c + 1" by auto
          then have "u y - u x > - c - 1" by auto
          with *** int2 show ?case unfolding less_eq dbm_le_def
          by (cases "M (v y) (v x)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
        qed
      }
      ultimately show ?case using R u  R R  
        apply -
        apply standard
         apply standard
         apply rule
          apply assumption
         apply (rule exI[where x = I], rule exI[where x = J], rule exI[where x = r])
      by auto
    qed
  qed
  with A have "S = ?U" by auto
  moreover have "?U  " by blast
  ultimately show ?case by blast
qed

lemma dbm_regions':
  "vabstr S M  normalized M  S  V   U  . S =  U"
using dbm_regions by (cases "S = {}") auto

lemma dbm_regions'':
  "dbm_int M n  normalized M  [M]v,n  V   U  . [M]v,n =  U"
using dbm_regions' by auto

lemma canonical_saturated_1:
  assumes "Le r  M (v c1) 0"
    and "Le (- r)  M 0 (v c1)"
    and "cycle_free M n"
    and "canonical M n"
    and "v c1  n"
    and "v c1 > 0"
    and "c. v c  n  0 < v c"
  obtains u where "u  [M]v,n" "u c1 = r"
proof -
  let ?M' = "λi' j'. if i'=v c1  j'=0 then Le r else if i'=0  j'=v c1 then Le (- r) else M i' j'"
  from fix_index'[OF assms(1-5)] assms(6) have M':
    "u. DBM_val_bounded v u ?M' n  DBM_val_bounded v u M n"
    "cycle_free ?M' n" "?M' (v c1) 0 = Le r" "?M' 0 (v c1) = Le (- r)"
  by auto
  with cyc_free_obtains_valuation[unfolded cycle_free_diag_equiv, of ?M' n v] assms(7) obtain u where
    u: "DBM_val_bounded v u ?M' n"
  by fastforce
  with assms(5,6) M'(3,4) have "u c1 = r" unfolding DBM_val_bounded_def by fastforce
  moreover from u M'(1) have "u  [M]v,n" unfolding DBM_zone_repr_def by auto
  ultimately show thesis by (auto intro: that)
qed

lemma canonical_saturated_2:
  assumes "Le r  M 0 (v c2)"
    and "Le (- r)  M (v c2) 0"
    and "cycle_free M n"
    and "canonical M n"
    and "v c2  n"
    and "v c2 > 0"
    and "c. v c  n  0 < v c"
  obtains u where "u  [M]v,n" "u c2 = - r"
proof -
  let ?M' = "λi' j'. if i'=0  j'=v c2 then Le r else if i'=v c2  j'=0 then Le (-r) else M i' j'"
  from fix_index'[OF assms(1-4)] assms(5,6) have M':
    "u. DBM_val_bounded v u ?M' n  DBM_val_bounded v u M n"
    "cycle_free ?M' n" "?M' 0 (v c2) = Le r" "?M' (v c2) 0 = Le (- r)"
  by auto
  with cyc_free_obtains_valuation[unfolded cycle_free_diag_equiv, of ?M' n v] assms(7) obtain u where
    u: "DBM_val_bounded v u ?M' n"
  by fastforce
  with assms(5,6) M'(3,4) have "u c2  -r" "- u c2  r" unfolding DBM_val_bounded_def by fastforce+
  then have "u c2 = -r" by (simp add: le_minus_iff)
  moreover from u M'(1) have "u  [M]v,n" unfolding DBM_zone_repr_def by auto
  ultimately show thesis by (auto intro: that)
qed

lemma canonical_saturated_3:
  assumes "Le r  M (v c1) (v c2)"
    and "Le (- r)  M (v c2) (v c1)"
    and "cycle_free M n"
    and "canonical M n"
    and "v c1  n" "v c2  n"
    and "v c1  v c2"
    and "c. v c  n  0 < v c"
  obtains u where "u  [M]v,n" "u c1 - u c2 = r"
proof -
  let ?M'="λi' j'. if i'=v c1  j'=v c2 then Le r else if i'=v c2  j'=v c1 then Le (-r) else M i' j'"
  from fix_index'[OF assms(1-7), of v] assms(7,8) have M':
    "u. DBM_val_bounded v u ?M' n  DBM_val_bounded v u M n"
    "cycle_free ?M' n" "?M' (v c1) (v c2) = Le r" "?M' (v c2) (v c1) = Le (- r)"
  by auto
  with cyc_free_obtains_valuation[unfolded cycle_free_diag_equiv, of ?M' n v] assms obtain u where u:
    "DBM_val_bounded v u ?M' n"
  by fastforce
  with assms(5,6) M'(3,4) have
    "u c1 - u c2  r" "u c2 - u c1  - r"
  unfolding DBM_val_bounded_def by fastforce+
  then have "u c1 - u c2 = r" by (simp add: le_minus_iff)
  moreover from u M'(1) have "u  [M]v,n" unfolding DBM_zone_repr_def by auto
  ultimately show thesis by (auto intro: that)
qed

lemma DBM_canonical_subset_le:
  notes any_le_inf[intro]
  fixes M :: "t DBM"
  assumes "canonical M n" "[M]v,n  [M']v,n" "[M]v,n  {}" "i  n" "j  n" "i  j"
  shows "M i j  M' i j"
proof -
  from non_empty_cycle_free[OF assms(3)] clock_numbering(2) have "cycle_free M n" by auto
  with assms(1,4,5) have non_neg:
    "M i j + M j i  Le 0"
  by (metis cycle_free_diag order.trans neutral)
  
  from clock_numbering have cn: "c. v c  n  0 < v c" by auto
  show ?thesis
  proof (cases "i = 0")
    case True
    show ?thesis
    proof (cases "j = 0")
      case True
      with assms i = 0 show ?thesis
      unfolding neutral DBM_zone_repr_def DBM_val_bounded_def less_eq by auto
    next
      case False
      then have "j > 0" by auto
      with j  n clock_numbering obtain c2 where c2: "v c2 = j" by auto
      note t = canonical_saturated_2[OF _ _ ‹cycle_free M n assms(1) assms(5)[folded c2] _ cn,unfolded c2]
      show ?thesis
      proof (rule ccontr, goal_cases)
        case 1
        { fix d assume 1: "M 0 j = "
          obtain r where r: "Le r  M 0 j" "Le (-r)  M j 0" "d < r"
          proof (cases "M j 0")
            case (Le d')
            obtain r where "r > - d'" using gt_ex by blast
            with Le 1 show ?thesis by (intro that[of "max r (d + 1)"]) auto
          next
            case (Lt d')
            obtain r where "r > - d'" using gt_ex by blast
            with Lt 1 show ?thesis by (intro that[of "max r (d + 1)"]) auto
          next
            case INF
            with 1 show ?thesis by (intro that[of "d + 1"]) auto
          qed
          then have " r. Le r  M 0 j  Le (-r)  M j 0  d < r" by auto
        } note inf_case = this
        { fix a b d :: real assume 1: "a < b" assume b: "b + d > 0"
          then have *: "b > -d" by auto
          obtain r where "r > - d" "r > a" "r < b"
          proof (cases "a  - d")
            case True
            from 1 obtain r where "r > a" "r < b" using dense by auto
            with True show ?thesis by (auto intro: that[of r])
          next
            case False
            with * obtain r where "r > -d" "r < b" using dense by auto
            with False show ?thesis by (auto intro: that[of r])
          qed
          then have " r. r > -d  r > a  r < b" by auto
        } note gt_case = this
        { fix a r assume r: "Le r  M 0 j" "Le (-r)  M j 0" "a < r" "M' 0 j = Le a  M' 0 j = Lt a"
          from t[OF this(1,2) 0 < j] obtain u where u: "u  [M]v,n" "u c2 = - r" .
          with j  n c2 assms(2) have "dbm_entry_val u None (Some c2) (M' 0 j)"
          unfolding DBM_zone_repr_def DBM_val_bounded_def by blast
          with u(2) r(3,4) have False by auto
        } note contr = this
        from 1 True have "M' 0 j < M 0 j" by auto
        then show False unfolding less
        proof (cases rule: dbm_lt.cases)
          case (1 d)
          with inf_case obtain r where r: "Le r  M 0 j" "Le (-r)  M j 0" "d < r" by auto
          from contr[OF this] 1 show False by fast
        next
          case (2 d)
          with inf_case obtain r where r: "Le r  M 0 j" "Le (-r)  M j 0" "d < r" by auto
          from contr[OF this] 2 show False by fast
        next
          case (3 a b)
          obtain r where r: "Le r  M 0 j" "Le (-r)  M j 0" "a < r"
          proof (cases "M j 0")
            case (Le d')
            with 3 non_neg i = 0 have "b + d'  0" unfolding mult by auto
            then have "b  - d'" by auto
            with 3 obtain r where "r  - d'" "r > a" "r  b" by blast
            with Le 3 show ?thesis by (intro that[of r]) auto
          next
            case (Lt d')
            with 3 non_neg i = 0 have "b + d' > 0" unfolding mult by auto
            from gt_case[OF 3(3) this] obtain r where "r > - d'" "r > a" "r  b" by auto
            with Lt 3 show ?thesis by (intro that[of r]) auto
          next
            case INF
            with 3 show ?thesis by (intro that[of b]) auto
          qed
          from contr[OF this] 3 show False by fast
        next
          case (4 a b)
          obtain r where r: "Le r  M 0 j" "Le (-r)  M j 0" "a < r"
          proof (cases "M j 0")
            case (Le d)
            with 4 non_neg i = 0 have "b + d > 0" unfolding mult by auto
            from gt_case[OF 4(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
            with Le 4 show ?thesis by (intro that[of r]) auto
          next
            case (Lt d)
            with 4 non_neg i = 0 have "b + d > 0" unfolding mult by auto
            from gt_case[OF 4(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
            with Lt 4 show ?thesis by (intro that[of r]) auto
          next
            case INF
            from 4 dense obtain r where "r > a" "r < b" by auto
            with 4 INF show ?thesis by (intro that[of r]) auto
          qed
          from contr[OF this] 4 show False by fast
        next
          case (5 a b)
          obtain r where r: "Le r  M 0 j" "Le (-r)  M j 0" "a  r"
          proof (cases "M j 0")
            case (Le d')
            with 5 non_neg i = 0 have "b + d'  0" unfolding mult by auto
            then have "b  - d'" by auto
            with 5 obtain r where "r  - d'" "r  a" "r  b" by blast
            with Le 5 show ?thesis by (intro that[of r]) auto
          next
            case (Lt d')
            with 5 non_neg i = 0 have "b + d' > 0" unfolding mult by auto
            then have "b > - d'" by auto
            with 5 obtain r where "r > - d'" "r  a" "r  b" by blast
            with Lt 5 show ?thesis by (intro that[of r]) auto
          next
            case INF
            with 5 show ?thesis by (intro that[of b]) auto
          qed
          from t[OF this(1,2) j > 0] obtain u where u: "u  [M]v,n" "u c2 = - r" .
          with j  n c2 assms(2) have "dbm_entry_val u None (Some c2) (M' 0 j)"
          unfolding DBM_zone_repr_def DBM_val_bounded_def by blast
          with u(2) r(3) 5 show False by auto
        next
          case (6 a b)
          obtain r where r: "Le r  M 0 j" "Le (-r)  M j 0" "a < r"
          proof (cases "M j 0")
            case (Le d)
            with 6 non_neg i = 0 have "b + d > 0" unfolding mult by auto
            from gt_case[OF 6(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
            with Le 6 show ?thesis by (intro that[of r]) auto
          next
            case (Lt d)
            with 6 non_neg i = 0 have "b + d > 0" unfolding mult by auto
            from gt_case[OF 6(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
            with Lt 6 show ?thesis by (intro that[of r]) auto
          next
            case INF
            from 6 dense obtain r where "r > a" "r < b" by auto
            with 6 INF show ?thesis by (intro that[of r]) auto
          qed
          from contr[OF this] 6 show False by fast
        qed
      qed
    qed
  next
    case False
    then have "i > 0" by auto
    with i  n clock_numbering obtain c1 where c1: "v c1 = i" by auto
    show ?thesis
    proof (cases "j = 0")
      case True
      note t = canonical_saturated_1[OF _ _ ‹cycle_free M n assms(1) assms(4)[folded c1] _ cn,
                                     unfolded c1]
      show ?thesis
      proof (rule ccontr, goal_cases)
        case 1
        { fix d assume 1: "M i 0 = "
          obtain r where r: "Le r  M i 0" "Le (-r)  M 0 i" "d < r"
          proof (cases "M 0 i")
            case (Le d')
            obtain r where "r > - d'" using gt_ex by blast
            with Le 1 show ?thesis by (intro that[of "max r (d + 1)"]) auto
          next
            case (Lt d')
            obtain r where "r > - d'" using gt_ex by blast
            with Lt 1 show ?thesis by (intro that[of "max r (d + 1)"]) auto
          next
            case INF
            with 1 show ?thesis by (intro that[of "d + 1"]) auto
          qed
          then have " r. Le r  M i 0  Le (-r)  M 0 i  d < r" by auto
        } note inf_case = this
        { fix a b d :: real assume 1: "a < b" assume b: "b + d > 0"
          then have *: "b > -d" by auto
          obtain r where "r > - d" "r > a" "r < b"
          proof (cases "a  - d")
            case True
            from 1 obtain r where "r > a" "r < b" using dense by auto
            with True show ?thesis by (auto intro: that[of r])
          next
            case False
            with * obtain r where "r > -d" "r < b" using dense by auto
            with False show ?thesis by (auto intro: that[of r])
          qed
          then have " r. r > -d  r > a  r < b" by auto
        } note gt_case = this
        { fix a r assume r: "Le r  M i 0" "Le (-r)  M 0 i" "a < r" "M' i 0 = Le a  M' i 0 = Lt a"
          from t[OF this(1,2) i > 0] obtain u where u: "u  [M]v,n" "u c1 = r" .
          with i  n c1 assms(2) have "dbm_entry_val u (Some c1) None (M' i 0)"
          unfolding DBM_zone_repr_def DBM_val_bounded_def by blast
          with u(2) r(3,4) have False by auto
        } note contr = this
        from 1 True have "M' i 0 < M i 0" by auto
        then show False unfolding less
        proof (cases rule: dbm_lt.cases)
          case (1 d)
          with inf_case obtain r where r: "Le r  M i 0" "Le (-r)  M 0 i" "d < r" by auto
          from contr[OF this] 1 show False by fast
        next
          case (2 d)
          with inf_case obtain r where r: "Le r  M i 0" "Le (-r)  M 0 i" "d < r" by auto
          from contr[OF this] 2 show False by fast
        next
          case (3 a b)
          obtain r where r: "Le r  M i 0" "Le (-r)  M 0 i" "a < r"
          proof (cases "M 0 i")
            case (Le d')
            with 3 non_neg j = 0 have "b + d'  0" unfolding mult by auto
            then have "b  - d'" by auto
            with 3 obtain r where "r  - d'" "r > a" "r  b" by blast
            with Le 3 show ?thesis by (intro that[of r]) auto
          next
            case (Lt d')
            with 3 non_neg j = 0 have "b + d' > 0" unfolding mult by auto
            from gt_case[OF 3(3) this] obtain r where "r > - d'" "r > a" "r  b" by auto
            with Lt 3 show ?thesis by (intro that[of r]) auto
          next
            case INF
            with 3 show ?thesis by (intro that[of b]) auto
          qed
          from contr[OF this] 3 show False by fast
        next
          case (4 a b)
          obtain r where r: "Le r  M i 0" "Le (-r)  M 0 i" "a < r"
          proof (cases "M 0 i")
            case (Le d)
            with 4 non_neg j = 0 have "b + d > 0" unfolding mult by auto
            from gt_case[OF 4(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
            with Le 4 show ?thesis by (intro that[of r]) auto
          next
            case (Lt d)
            with 4 non_neg j = 0 have "b + d > 0" unfolding mult by auto
            from gt_case[OF 4(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
            with Lt 4 show ?thesis by (intro that[of r]) auto
          next
            case INF
            from 4 dense obtain r where "r > a" "r < b" by auto
            with 4 INF show ?thesis by (intro that[of r]) auto
          qed
          from contr[OF this] 4 show False by fast
        next
          case (5 a b)
          obtain r where r: "Le r  M i 0" "Le (-r)  M 0 i" "a  r"
          proof (cases "M 0 i")
            case (Le d')
            with 5 non_neg j = 0 have "b + d'  0" unfolding mult by auto
            then have "b  - d'" by auto
            with 5 obtain r where "r  - d'" "r  a" "r  b" by blast
            with Le 5 show ?thesis by (intro that[of r]) auto
          next
            case (Lt d')
            with 5 non_neg j = 0 have "b + d' > 0" unfolding mult by auto
            then have "b > - d'" by auto
            with 5 obtain r where "r > - d'" "r  a" "r  b" by blast
            with Lt 5 show ?thesis by (intro that[of r]) auto
          next
            case INF
            with 5 show ?thesis by (intro that[of b]) auto
          qed
          from t[OF this(1,2) i > 0] obtain u where u: "u  [M]v,n" "u c1 = r" .
          with i  n c1 assms(2) have "dbm_entry_val u (Some c1) None (M' i 0)"
          unfolding DBM_zone_repr_def DBM_val_bounded_def by blast
          with u(2) r(3) 5 show False by auto
        next
          case (6 a b)
          obtain r where r: "Le r  M i 0" "Le (-r)  M 0 i" "a < r"
          proof (cases "M 0 i")
            case (Le d)
            with 6 non_neg j = 0 have "b + d > 0" unfolding mult by auto
            from gt_case[OF 6(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
            with Le 6 show ?thesis by (intro that[of r]) auto
          next
            case (Lt d)
            with 6 non_neg j = 0 have "b + d > 0" unfolding mult by auto
            from gt_case[OF 6(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
            with Lt 6 show ?thesis by (intro that[of r]) auto
          next
            case INF
            from 6 dense obtain r where "r > a" "r < b" by auto
            with 6 INF show ?thesis by (intro that[of r]) auto
          qed
          from contr[OF this] 6 show False by fast
        qed
      qed
    next
      case False
      then have "j > 0" by auto
      with j  n clock_numbering obtain c2 where c2: "v c2 = j" by auto
      note t = canonical_saturated_3[OF _ _ ‹cycle_free M n assms(1) assms(4)[folded c1]
                                        assms(5)[folded c2] _ cn, unfolded c1 c2]
      show ?thesis
      proof (rule ccontr, goal_cases)
        case 1
        { fix d assume 1: "M i j = "
          obtain r where r: "Le r  M i j" "Le (-r)  M j i" "d < r"
          proof (cases "M j i")
            case (Le d')
            obtain r where "r > - d'" using gt_ex by blast
            with Le 1 show ?thesis by (intro that[of "max r (d + 1)"]) auto
          next
            case (Lt d')
            obtain r where "r > - d'" using gt_ex by blast
            with Lt 1 show ?thesis by (intro that[of "max r (d + 1)"]) auto
          next
            case INF
            with 1 show ?thesis by (intro that[of "d + 1"]) auto
          qed
          then have " r. Le r  M i j  Le (-r)  M j i  d < r" by auto
        } note inf_case = this
        { fix a b d :: real assume 1: "a < b" assume b: "b + d > 0"
          then have *: "b > -d" by auto
          obtain r where "r > - d" "r > a" "r < b"
          proof (cases "a  - d")
            case True
            from 1 obtain r where "r > a" "r < b" using dense by auto
            with True show ?thesis by (auto intro: that[of r])
          next
            case False
            with * obtain r where "r > -d" "r < b" using dense by auto
            with False show ?thesis by (auto intro: that[of r])
          qed
          then have " r. r > -d  r > a  r < b" by auto
        } note gt_case = this
        { fix a r assume r: "Le r  M i j" "Le (-r)  M j i" "a < r" "M' i j = Le a  M' i j = Lt a"
          from t[OF this(1,2) i  j] obtain u where u: "u  [M]v,n" "u c1 - u c2 = r" .
          with i  n j  n c1 c2 assms(2) have "dbm_entry_val u (Some c1) (Some c2) (M' i j)"
          unfolding DBM_zone_repr_def DBM_val_bounded_def by blast
          with u(2) r(3,4) have False by auto
        } note contr = this
        from 1 have "M' i j < M i j" by auto
        then show False unfolding less
        proof (cases rule: dbm_lt.cases)
          case (1 d)
          with inf_case obtain r where r: "Le r  M i j" "Le (-r)  M j i" "d < r" by auto
          from contr[OF this] 1 show False by fast
        next
          case (2 d)
          with inf_case obtain r where r: "Le r  M i j" "Le (-r)  M j i" "d < r" by auto
          from contr[OF this] 2 show False by fast
        next
          case (3 a b)
          obtain r where r: "Le r  M i j" "Le (-r)  M j i" "a < r"
          proof (cases "M j i")
            case (Le d')
            with 3 non_neg have "b + d'  0" unfolding mult by auto
            then have "b  - d'" by auto
            with 3 obtain r where "r  - d'" "r > a" "r  b" by blast
            with Le 3 show ?thesis by (intro that[of r]) auto
          next
            case (Lt d')
            with 3 non_neg have "b + d' > 0" unfolding mult by auto
            from gt_case[OF 3(3) this] obtain r where "r > - d'" "r > a" "r  b" by auto
            with Lt 3 show ?thesis by (intro that[of r]) auto
          next
            case INF
            with 3 show ?thesis by (intro that[of b]) auto
          qed
          from contr[OF this] 3 show False by fast
        next
          case (4 a b)
          obtain r where r: "Le r  M i j" "Le (-r)  M j i" "a < r"
          proof (cases "M j i")
            case (Le d)
            with 4 non_neg have "b + d > 0" unfolding mult by auto
            from gt_case[OF 4(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
            with Le 4 show ?thesis by (intro that[of r]) auto
          next
            case (Lt d)
            with 4 non_neg have "b + d > 0" unfolding mult by auto
            from gt_case[OF 4(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
            with Lt 4 show ?thesis by (intro that[of r]) auto
          next
            case INF
            from 4 dense obtain r where "r > a" "r < b" by auto
            with 4 INF show ?thesis by (intro that[of r]) auto
          qed
          from contr[OF this] 4 show False by fast
        next
          case (5 a b)
          obtain r where r: "Le r  M i j" "Le (-r)  M j i" "a  r"
          proof (cases "M j i")
            case (Le d')
            with 5 non_neg have "b + d'  0" unfolding mult by auto
            then have "b  - d'" by auto
            with 5 obtain r where "r  - d'" "r  a" "r  b" by blast
            with Le 5 show ?thesis by (intro that[of r]) auto
          next
            case (Lt d')
            with 5 non_neg have "b + d' > 0" unfolding mult by auto
            then have "b > - d'" by auto
            with 5 obtain r where "r > - d'" "r  a" "r  b" by blast
            with Lt 5 show ?thesis by (intro that[of r]) auto
          next
            case INF
            with 5 show ?thesis by (intro that[of b]) auto
          qed
          from t[OF this(1,2) i  j] obtain u where u: "u  [M]v,n" "u c1 - u c2= r" .
          with i  n j  n c1 c2 assms(2) have "dbm_entry_val u (Some c1) (Some c2) (M' i j)"
          unfolding DBM_zone_repr_def DBM_val_bounded_def by blast
          with u(2) r(3) 5 show False by auto
        next
          case (6 a b)
          obtain r where r: "Le r  M i j" "Le (-r)  M j i" "a < r"
          proof (cases "M j i")
            case (Le d)
            with 6 non_neg have "b + d > 0" unfolding mult by auto
            from gt_case[OF 6(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
            with Le 6 show ?thesis by (intro that[of r]) auto
          next
            case (Lt d)
            with 6 non_neg have "b + d > 0" unfolding mult by auto
            from gt_case[OF 6(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
            with Lt 6 show ?thesis by (intro that[of r]) auto
          next
            case INF
            from 6 dense obtain r where "r > a" "r < b" by auto
            with 6 INF show ?thesis by (intro that[of r]) auto
          qed
          from contr[OF this] 6 show False by fast
        qed
      qed
    qed
  qed
qed

lemma DBM_set_diag:
  assumes "[M]v,n  {}"
  shows "[M]v,n = [(λ i j. if i = j then Le 0 else M i j)]v,n"
using non_empty_dbm_diag_set[OF clock_numbering(1) assms] unfolding neutral by auto

lemma DBM_le_subset':
  assumes "i  n.  j  n. i  j  M i j  M' i j"
  and " in. M' i i  Le 0"
  and "u  [M]v,n"
  shows "u  [M']v,n"
proof -
  let ?M = "λ i j. if i = j then Le 0 else M i j"
  have "i j. i  n  j  n  ?M i j  M' i j" using assms(1,2) by auto
  moreover from DBM_set_diag assms(3) have "u  [?M]v,n" by auto
  ultimately show ?thesis using DBM_le_subset[folded less_eq, of n ?M M' u v] by auto
qed

lemma neg_diag_empty_spec:
  assumes "i  n" "M i i < 𝟭"
  shows "[M]v,n = {}"
using assms neg_diag_empty[where v= v and M = M, OF _ assms] clock_numbering(2) by auto

lemma canonical_empty_zone_spec:
  assumes "canonical M n"
  shows "[M]v,n = {}  (in. M i i < 𝟭)"
using canonical_empty_zone[of n v M, OF _ _ assms] clock_numbering by auto

lemma norm_set_diag:
  assumes "canonical M n" "[M]v,n  {}"
  obtains M' where "[M]v,n = [M']v,n" "[norm M (k o v') n]v,n = [norm M' (k o v') n]v,n"
                   " i  n. M' i i = 𝟭" "canonical M' n"
proof -
  from assms(2) neg_diag_empty_spec have *: " in. M i i  Le 0" unfolding neutral by force
  let ?M = "λi j. if i = j then Le 0 else M i j"
  let ?NM = "norm M (k o v') n"
  let ?M2 = "λi j. if i = j then Le 0 else ?NM i j"
  from assms have "[?NM]v,n  {}"
  by (metis Collect_empty_eq norm_mono DBM_zone_repr_def clock_numbering(1) mem_Collect_eq)
  from DBM_set_diag[OF this] DBM_set_diag[OF assms(2)] have
    "[M]v,n = [?M]v,n" "[?NM]v,n = [?M2]v,n"
  by auto
  moreover have "norm ?M (k o v') n = ?M2" unfolding norm_def by fastforce
  moreover have " i  n. ?M i i = 𝟭" unfolding neutral by auto
  moreover have "canonical ?M n" using assms(1) *
  unfolding neutral[symmetric] less_eq[symmetric] mult[symmetric] by fastforce
  ultimately show ?thesis by (auto intro: that)
qed

lemma norm_normalizes:
  notes any_le_inf[intro]
  shows "normalized (norm M (k o v') n)"
unfolding normalized
proof (safe, goal_cases)
  case (1 i j)
  show ?case
  proof (cases "M i j < Lt (- real (k (v' j)))")
    case True with 1 show ?thesis unfolding norm_def less by (auto simp: Let_def)
  next
    case False
    with 1 show ?thesis unfolding norm_def by (auto simp: Let_def)
  qed
next
  case (2 i j)
  have **: "- real ((k o v') j)  (k o v') i" by simp
  then have *: "Lt (- k (v' j)) < Le (k (v' i))" by (auto intro: Lt_lt_LeI)
  show ?case
  proof (cases "M i j  Le (real (k (v' i)))")
    case False with 2 show ?thesis unfolding norm_def less_eq dbm_le_def by (auto simp: Let_def)
  next
    case True with 2 show ?thesis unfolding norm_def by (auto simp: Let_def)
  qed
next
  case (3 i)
  show ?case
  proof (cases "M i 0  Le (real (k (v' i)))")
    case False then have "Le (real (k (v' i)))  M i 0" unfolding less_eq dbm_le_def by auto
    with 3 show ?thesis unfolding norm_def by auto
  next
    case True
    with 3 show ?thesis unfolding norm_def less_eq dbm_le_def by (auto simp: Let_def)
  qed
next
  case (4 i)
  show ?case
  proof (cases "M 0 i < Lt (- real (k (v' i)))")
    case True with 4 show ?thesis unfolding norm_def less by auto
  next
    case False with 4 show ?thesis unfolding norm_def by (auto simp: Let_def)
  qed
qed

lemma norm_int_preservation:
  assumes "dbm_int M n" "i  n" "j  n" "norm M (k o v') n i j  "
  shows "get_const (norm M (k o v') n i j)  "
using assms unfolding norm_def by (auto simp: Let_def)

lemma norm_V_preservation':
  notes any_le_inf[intro]
  assumes "[M]v,n  V" "canonical M n" "[M]v,n  {}"
  shows "[norm M (k o v') n]v,n  V"
proof -
  let ?M = "norm M (k o v') n"
  from non_empty_cycle_free[OF assms(3)] clock_numbering(2) have *: "cycle_free M n" by auto
  { fix c assume "c  X"
    with clock_numbering have c: "c  X" "v c > 0" "v c  n" by auto
    with assms(2) have
      "M 0 (v c) + M (v c) 0  M 0 0"
    unfolding mult less_eq by blast
    moreover from cycle_free_diag[OF *] have "M 0 0  Le 0" unfolding neutral by auto
    ultimately have ge_0: "M 0 (v c) + M (v c) 0  Le 0" by auto
    have "M 0 (v c)  Le 0"
    proof (cases "M 0 (v c)")
      case (Le d)
      with ge_0 have "M (v c) 0  Le (-d)"
       apply (cases "M (v c) 0")
         unfolding mult apply auto
         apply (rename_tac x1)
         apply (subgoal_tac "-d  x1")
         apply auto
       apply (rename_tac x2)
       apply (subgoal_tac "-d < x2")
      by auto
      with Le canonical_saturated_2[OF _ _ ‹cycle_free M n assms(2) c(3)] clock_numbering(1)
      obtain u where "u  [M]v,n" "u c = -d" by auto
      with assms(1) c(1) Le show ?thesis unfolding V_def by fastforce
    next
      case (Lt d)
      show ?thesis
      proof (cases "d  0")
        case True
        then have "Lt d < Le 0" by (auto intro: Lt_lt_LeI)
        with Lt show ?thesis by auto
      next
        case False
        then have "d > 0" by auto
        note Lt' = Lt
        show ?thesis
        proof (cases "M (v c) 0")
          case (Le d')
          with Lt ge_0 have *: "d > -d'" unfolding mult by auto
          show ?thesis
          proof (cases "d' < 0")
            case True
            from * clock_numbering(1) canonical_saturated_1[OF _ _ ‹cycle_free _ _ assms(2) c(3)] Lt Le
            obtain u where "u  [M]v,n" "u c = d'" by auto
            with d' < 0 assms(1) c  X show ?thesis unfolding V_def by fastforce
          next
            case False
            then have "d'  0" by auto
            with d > 0 have "Le (d / 2)  Lt d" "Le (- (d /2))  Le d'" by auto
            with canonical_saturated_2[OF _ _ ‹cycle_free _ _ assms(2) c(3)] Lt Le clock_numbering(1)
            obtain u where "u  [M]v,n" "u c = - (d / 2)" by auto
            with d > 0 assms(1) c  X show ?thesis unfolding V_def by fastforce
          qed
        next
          case (Lt d')
          with Lt' ge_0 have *: "d > -d'" unfolding mult by auto
          then have **: "-d < d'" by auto
          show ?thesis
          proof (cases "d'  0")
            case True
            from assms(1,3) c obtain u where u:
              "u  V" "dbm_entry_val u (Some c) None (M (v c) 0)"
            unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
            with u(1) True Lt c  X show ?thesis unfolding V_def by auto
          next
            case False
            with d > 0 have "Le (d / 2)  Lt d" "Le (- (d /2))  Lt d'" by auto
            with canonical_saturated_2[OF _ _ ‹cycle_free _ _ assms(2) c(3)] Lt Lt' clock_numbering(1)
            obtain u where "u  [M]v,n" "u c = - (d / 2)" by auto
            with d > 0 assms(1) c  X show ?thesis unfolding V_def by fastforce
          qed
        next
          case INF
          show ?thesis
          proof (cases "d > 0")
            case True
            from d > 0 have "Le (d / 2)  Lt d" by auto
            with INF canonical_saturated_2[OF _ _ ‹cycle_free _ _ assms(2) c(3)] Lt clock_numbering(1)
            obtain u where "u  [M]v,n" "u c = - (d / 2)" by auto
            with d > 0 assms(1) c  X show ?thesis unfolding V_def by fastforce
          next
            case False
            with Lt show ?thesis by auto
          qed
        qed
      qed
    next
      case INF
      obtain u r where "u  [M]v,n" "u c = - r" "r > 0"
      proof (cases "M (v c) 0")
        case (Le d)
        let ?d = "if d  0 then -d + 1 else d"
        from Le INF canonical_saturated_2[OF _ _ ‹cycle_free _ _ assms(2) c(3), of ?d] clock_numbering(1)
        obtain u where "u  [M]v,n" "u c = - ?d" by (cases "d < 0") force+
        from that[OF this] show thesis by auto
      next
        case (Lt d)
        let ?d = "if d  0 then -d + 1 else d"
        from Lt INF canonical_saturated_2[OF _ _ ‹cycle_free _ _ assms(2) c(3), of ?d] clock_numbering(1)
        obtain u where "u  [M]v,n" "u c = - ?d" by (cases "d < 0") force+
        from that[OF this] show thesis by auto
      next
        case INF
        with M 0 (v c) =  canonical_saturated_2[OF _ _ ‹cycle_free _ _ assms(2) c(3)] clock_numbering(1)
        obtain u where "u  [M]v,n" "u c = - 1" by auto
        from that[OF this] show thesis by auto
      qed
      with assms(1) c  X show ?thesis unfolding V_def by fastforce
    qed
    moreover then have "¬ Le 0  M 0 (v c)" unfolding less[symmetric] by auto
    ultimately have *: "?M 0 (v c)  Le 0" using assms(3) c unfolding norm_def by (auto simp: Let_def)
    fix u assume u: "u  [?M]v,n"
    with c have "dbm_entry_val u None (Some c) (?M 0 (v c))"
    unfolding DBM_val_bounded_def DBM_zone_repr_def by auto
    with * have "u c  0" by (cases "?M 0 (v c)") auto
  } note ge_0 = this
  then show ?thesis unfolding V_def by auto
qed

lemma norm_V_preservation:
  assumes "[M]v,n  V" "canonical M n"
  shows "[norm M (k o v') n]v,n  V" (is "[?M]v,n  V")
proof (cases "[M]v,n = {}")
  case True
  obtain i where i: "i  n" "M i i < 𝟭" by (metis True assms(2) canonical_empty_zone_spec)
  have "¬ Le (k (v' i)) < Le 0" unfolding less by (cases "k (v' i) = 0", auto)
  with i have "?M i i < 𝟭" unfolding norm_def by (auto simp: neutral less Let_def)
  with neg_diag_empty_spec[OF i  n] have "[?M]v,n = {}" .
  then show ?thesis by auto
next
  case False
  from norm_set_diag[OF assms(2) False] norm_V_preservation' False assms
  show ?thesis by metis
qed

lemma norm_min:
  assumes "normalized M1" "[M]v,n  [M1]v,n"
          "canonical M n" "[M]v,n  {}" "[M]v,n  V"
  shows "[norm M (k o v') n]v,n  [M1]v,n" (is "[?M2]v,n  [M1]v,n")
proof -
  have le: " i j. i  n  j  n  i  j M i j  M1 i j" using assms(2,3,4)
  by (auto intro!: DBM_canonical_subset_le)
  from assms have "[M1]v,n  {}" by auto
  with neg_diag_empty_spec have *: " in. M1 i i  Le 0" unfolding neutral by force
  from assms norm_V_preservation have V: "[?M2]v,n  V" by auto
  have "u  [M1]v,n" if "u  [?M2]v,n" for u
  proof -
    from that V have V: "u  V" by fast
    show ?thesis unfolding DBM_zone_repr_def DBM_val_bounded_def
    proof (safe, goal_cases)
      case 1 with * show ?case unfolding less_eq by fast
    next
      case (2 c)
      then have c: "v c > 0" "v c  n" "c  X" "v' (v c) = c" using clock_numbering v_v' by metis+
      with V have v_bound: "dbm_entry_val u None (Some c) (Le 0)" unfolding V_def by auto
      from that c have bound:
        "dbm_entry_val u None (Some c) (?M2 0 (v c))"
      unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
      show ?case
      proof (cases "M 0 (v c) < Lt (- k c)")
        case False
        show ?thesis
        proof (cases "Le 0 < M 0 (v c)")
          case True
          with le c(1,2) have "Le 0  M1 0 (v c)" by fastforce
          with dbm_entry_val_mono_2[OF v_bound, folded less_eq] show ?thesis by fast
        next
          case F: False
          with assms(3) False c have "?M2 0 (v c) = M 0 (v c)" unfolding less norm_def by auto
          with le c bound show ?thesis by (auto intro: dbm_entry_val_mono_2[folded less_eq])
        qed
      next
        case True
        have "Lt (- k c)  Le 0" by auto
        with True c assms(3) have "?M2 0 (v c) = Lt (- k c)" unfolding less norm_def by auto
        moreover from assms(1) c have "Lt (- k c)  M1 0 (v c)" unfolding normalized by auto
        ultimately show ?thesis using le c bound by (auto intro: dbm_entry_val_mono_2[folded less_eq])
      qed
    next
      case (3 c)
      then have c: "v c > 0" "v c  n" "c  X" "v' (v c) = c" using clock_numbering v_v' by metis+
      from that c have bound:
        "dbm_entry_val u (Some c) None (?M2 (v c) 0)"
      unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
      show ?case
      proof (cases "M (v c) 0  Le (k c)")
        case False
        with le c have "¬ M1 (v c) 0  Le (k c)" by fastforce
        with assms(1) c show ?thesis unfolding normalized by fastforce
      next
        case True
        show ?thesis
        proof (cases "M (v c) 0 < Lt 0")
          case T: True
          have "¬ Le (real (k c))  Lt 0" by auto
          with T True c have "?M2 (v c) 0 = Lt 0" unfolding norm_def less by (auto simp: Let_def)
          with bound V c show ?thesis unfolding V_def by auto
        next
          case False
          with True assms(3) c have "?M2 (v c) 0 = M (v c) 0" unfolding less less_eq norm_def
          by (auto simp: Let_def)
          with dbm_entry_val_mono_3[OF bound, folded less_eq] le c show ?thesis by auto
        qed
      qed
    next
      case (4 c1 c2)
      then have c:
        "v c1 > 0" "v c1  n" "c1  X" "v' (v c1) = c1" "v c2 > 0" "v c2  n" "c2  X" "v' (v c2) = c2"
      using clock_numbering v_v' by metis+
      from that c have bound:
        "dbm_entry_val u (Some c1) (Some c2) (?M2 (v c1) (v c2))"
      unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
      show ?case
      proof (cases "c1 = c2")
        case True
        then have "dbm_entry_val u (Some c1) (Some c2) (Le 0)" by auto
        with c True * dbm_entry_val_mono_1[OF this, folded less_eq] show ?thesis by auto
      next
        case False
        with clock_numbering(1) v c1  n v c2  n have neq: "v c1  v c2" by auto
        show ?thesis
        proof (cases "Le (k c1) < M (v c1) (v c2)")
          case False
          show ?thesis
          proof (cases "M (v c1) (v c2) < Lt (- real (k c2))")
            case F: False
            with c False assms(3) have
              "?M2 (v c1) (v c2) = M (v c1) (v c2)"
            unfolding norm_def less by auto
            with dbm_entry_val_mono_1[OF bound, folded less_eq] le c neq show ?thesis by auto
          next
            case True
            with c False assms(3) have "?M2 (v c1) (v c2) = Lt (- k c2)" unfolding less norm_def
            by auto
            moreover from assms(1) c have "M1 (v c1) (v c2) =   M1 (v c1) (v c2)  Lt (- k c2)"
            unfolding normalized by fastforce
            ultimately show ?thesis using dbm_entry_val_mono_1[OF bound, folded less_eq] by auto
          qed
        next
          case True
          with le c neq have "M1 (v c1) (v c2) > Le (k c1)" by fastforce
          moreover from True c assms(3) have "?M2 (v c1) (v c2) = " unfolding norm_def less
          by auto
          moreover from assms(1) c have "M1 (v c1) (v c2) =   M1 (v c1) (v c2)  Le (k c1)"
          unfolding normalized by fastforce
          ultimately show ?thesis by auto
        qed
      qed
    qed
  qed
  then show ?thesis by blast
qed

lemma apx_norm_eq:
  assumes "canonical M n" "[M]v,n  V" "dbm_int M n"
  shows "Approxβ ([M]v,n) = [norm M (k o v') n]v,n"
proof -
  let ?M = "norm M (k o v') n"
  from assms norm_V_preservation norm_int_preservation norm_normalizes
  have *: "vabstr ([?M]v,n) ?M" "normalized ?M" "[?M]v,n  V" by presburger+
  from dbm_regions'[OF this] obtain U where U: "U  " "[?M]v,n = U" by auto
  from assms(3) have **: "[M]v,n  [?M]v,n" by (simp add: norm_mono clock_numbering(1) subsetI) 
  show ?thesis
  proof (cases "[M]v,n = {}")
    case True
    from canonical_empty_zone_spec[OF ‹canonical M n] True obtain i where i:
      "i  n" "M i i < 𝟭"
    by auto
    with assms(3) have "?M i i < 𝟭" unfolding neutral norm_def
    proof (cases "i = 0", auto intro: Lt_lt_LeI, goal_cases)
      case 1
      then show ?case unfolding less by auto
    next
      case 2
      have "¬ Le (real (k (v' i)))  Le 0" by auto
      with 2 show ?case by (auto simp: Let_def less)
    qed
    from neg_diag_empty[of n v i ?M, OF _ i  n this] clock_numbering have
      "[?M]v,n = {}"
    by (auto intro: Lt_lt_LeI)
    with apx_empty True show ?thesis by auto
  next
    case False
    from apx_in[OF assms(2)] obtain U' M1 where U':
      "Approxβ ([M]v,n) = U'" "U'  " "[M]v,n  Approxβ ([M]v,n)"
      "vabstr (Approxβ ([M]v,n)) M1" "normalized M1"
    by auto
    from norm_min[OF U'(5) _ assms(1) False assms(2)] U'(3,4) *(1) apx_min[OF U(2,1) _ _ *(2) **]
    show ?thesis by blast
  qed
qed

end        


section ‹Auxiliary β›-boundedness Theorems›

context Beta_Regions'
begin

lemma β_boundedness_diag_lt:
  fixes m :: int
  assumes "- k y  m" "m  k x" "x  X" "y  X"
  shows " U  .  U = {u  V. u x - u y < m}"
proof -
  note A = assms
  note B = A(1,2)
  let ?U = "{R  .  I J r c d (e :: int). R = region X I J r  valid_region X k I J r 
    (I x = Const c  I y = Const d  real c - d < m 
     I x = Const c  I y = Intv d   real c - d  m 
     I x = Intv c   I y = Const d  real c + 1 - d  m 
     I x = Intv c   I y = Intv d   real c - d  m  (x,y)  r  (y, x)  r 
     I x = Intv c   I y = Intv d   real c - d < m  (y, x)  r 
     (I x = Greater (k x)  I y = Greater (k y))  J x y = Smaller' (- k y) 
     (I x = Greater (k x)  I y = Greater (k y))  J x y = Intv' e   e < m 
     (I x = Greater (k x)  I y = Greater (k y))  J x y = Const' e  e < m
    )}"
  { fix u I J r assume "u  region X I J r" "I x = Greater (k x)  I y = Greater (k y)"
    with A(3,4) have "intv'_elem x y u (J x y)" by force
  } note * = this
  { fix u I J r assume "u  region X I J r"
    with A(3,4) have "intv_elem x u (I x)" "intv_elem y u (I y)" by force+
  } note ** = this
  have " ?U = {u  V. u x - u y < m}"
  proof (safe, goal_cases)
    case (2 u) with **[OF this(1)] show ?case by auto
  next
    case (4 u) with **[OF this(1)] show ?case by auto
  next
    case (6 u) with **[OF this(1)] show ?case by auto
  next
    case (8 u X I J r c d)
    from this A(3,4) have "intv_elem x u (I x)" "intv_elem y u (I y)" "frac (u x) < frac (u y)" by force+
    with nat_intv_frac_decomp 8(4,5) have
      "u x = c + frac (u x)" "u y = d + frac (u y)" "frac (u x) < frac (u y)"
    by force+
    with 8(6) show ?case by linarith
  next
    case (10 u X I J r c d)
    with **[OF this(1)] 10(4,5) have "u x < c + 1" "d < u y" by auto
    then have "u x - u y < real (c + 1) - real d" by linarith
    moreover from 10(6) have "real c + 1 - d  m"
    proof -
      have "int c - int d < m"
        using 10(6) by linarith
      then show ?thesis
        by simp
    qed
    ultimately show ?case by linarith
  next
    case 12 with *[OF this(1)] B show ?case by auto
  next
    case 14 with *[OF this(1)] B show ?case by auto
  next
    case (23 u)
    from region_cover_V[OF this(1)] obtain R where R: "R  " "u  R" by auto
    then obtain I J r where R': "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
    with R' R(2) A have C:
      "intv_elem x u (I x)" "intv_elem y u (I y)" "valid_intv (k x) (I x)" "valid_intv (k y) (I y)"
    by auto
    { assume A: "I x = Greater (k x)  I y = Greater (k y)"
      obtain intv and d :: int where intv:
        "valid_intv' (k y) (k x) intv" "intv'_elem x y u intv"
        "intv = Smaller' (- k y)  intv = Intv' d  d < m  intv = Const' d  d < m"
      proof (cases "u x - u y < - int (k y)")
        case True
        have "valid_intv' (k y) (k x) (Smaller' (- k y))" ..
        moreover with True have "intv'_elem x y u (Smaller' (- k y))" by auto
        ultimately show thesis by (auto intro: that)
      next
        case False
        show thesis
        proof (cases " (c :: int). u x - u y = c")
          case True
          then obtain c :: int where c: "u x - u y = c" by auto
          have "valid_intv' (k y) (k x) (Const' c)" using False B(2) 23(2) c by fastforce
          moreover with c have "intv'_elem x y u (Const' c)" by auto
          moreover have "c < m" using c 23(2) by auto
          ultimately show thesis by (auto intro: that)
        next
          case False
          then obtain c :: real where c: "u x - u y = c" "c  " by (metis Ints_cases)
          have "valid_intv' (k y) (k x) (Intv' (floor c))"
          proof
            show "- int (k y)  c" using ¬ _ < _ c by linarith
            show "c < int (k x)" using B(2) 23(2) c by linarith
          qed
          moreover have "intv'_elem x y u (Intv' (floor c))"
          proof
            from c(1,2) show "c < u x - u y" by (meson False eq_iff not_le of_int_floor_le)
            from c(1,2) show "u x - u y < c + 1" by simp
          qed
          moreover have "c < m" using c 23(2) by linarith
          ultimately show thesis using that by auto
        qed
      qed
      let ?J = "λ a b. if x = a  y = b then intv else J a b"
      let ?R = "region X I ?J r"
      let ?X0 = "{x  X. d. I x = Intv d}"
      have "u  ?R"
      proof (standard, goal_cases)
        case 1 from R R' show ?case by auto
      next
        case 2 from R R' show ?case by auto
      next
        case 3 show "?X0 = ?X0" by auto
      next
        case 4 from R R' show "x?X0. y?X0. (x, y)  r  frac (u x)  frac (u y)" by auto
      next
        case 5
        show ?case
        proof (clarify, goal_cases)
          case (1 a b)
          show ?case
          proof (cases "x = a  y = b")
            case True with intv show ?thesis by auto
          next
            case False
            with R(2) R'(1) 1 show ?thesis by force
          qed
        qed
      qed
      have "valid_region X k I ?J r"
      proof
        show "?X0 = ?X0" ..
        show "refl_on ?X0 r" using R' by auto
        show "trans r" using R' by auto
        show "total_on ?X0 r" using R' by auto
        show "xX. valid_intv (k x) (I x)" using R' by auto
        show "xaX. yaX. isGreater (I xa)  isGreater (I ya)
               valid_intv' (int (k ya)) (int (k xa)) (if x = xa  y = ya then intv else J xa ya)"
        proof (clarify, goal_cases)
          case (1 a b)
          show ?case
          proof (cases "x = a  y = b")
            case True
            with B intv show ?thesis by auto
          next
            case False
            with R'(2) 1 show ?thesis by force
          qed
        qed
      qed
      moreover then have "?R  " unfolding ℛ_def by auto
      ultimately have "?R  ?U" using intv
        apply clarify
        apply (rule exI[where x = I], rule exI[where x = ?J], rule exI[where x = r])
      using A by fastforce
      with u  region _ _ _ _ have ?case by (intro Complete_Lattices.UnionI) blast+
    } note * = this
    show ?case
    proof (cases "I x")
      case (Const c)
      show ?thesis
      proof (cases "I y", goal_cases)
        case (1 d)
        with C(1,2) Const A(2,3) 23(2) have "real c - real d < m" by auto
        with Const 1 R R' show ?thesis by blast
      next
        case (Intv d)
        with C(1,2) Const A(2,3) 23(2) have "real c - (d + 1) < m" by auto
        then have "c < 1 + (d + m)" by linarith
        then have "real c - d  m" by simp
        with Const Intv R R' show ?thesis by blast
      next
        case (Greater d) with * C(4) show ?thesis by auto
      qed
    next
      case (Intv c)
      show ?thesis
      proof (cases "I y", goal_cases)
        case (Const d)
        with C(1,2) Intv A(2,3) 23(2) have "real c - d < m" by auto
        then have "real c < m + d" by linarith
        then have "c < m + d" by linarith 
        then have "real c + 1 - d  m" by simp
        with Const Intv R R' show ?thesis by blast
      next
        case (2 d)
        show ?thesis
        proof (cases "(y, x)  r")
          case True
          with C(1,2) R R' Intv 2 A(3,4) have
            "c < u x" "u x < c + 1" "d < u y" "u y < d + 1" "frac (u x)  frac (u y)"
          by force+
          with 23(2) nat_intv_frac_decomp have "c + frac (u x) - (d + frac (u y)) < m" by auto
          with ‹frac _  _ have "real c - real d < m" by linarith
          with Intv 2 True R R' show ?thesis by blast
        next
          case False
          with R R' A(3,4) Intv 2 have "(x,y)  r" by fastforce
          with C(1,2) R R' Intv 2 have "c < u x" "u y < d + 1" by force+
          with 23(2) have "c < 1 + d + m" by auto
          then have "real c - d  m" by simp
          with Intv 2 False _  r R R' show ?thesis by blast
        qed
      next
        case (Greater d) with * C(4) show ?thesis by auto
      qed
    next
      case (Greater d) with * C(3) show ?thesis by auto
    qed
  qed (auto intro: A simp: V_def, (fastforce dest!: *)+)
  moreover have "?U  " by fastforce
  ultimately show ?thesis by blast
qed

lemma β_boundedness_diag_eq:
  fixes m :: int
  assumes "- k y  m" "m  k x" "x  X" "y  X"
  shows " U  .  U = {u  V. u x - u y = m}"
proof -
  note A = assms
  note B = A(1,2)
  let ?U = "{R  .  I J r c d (e :: int). R = region X I J r  valid_region X k I J r 
    (I x = Const c  I y = Const d  real c - d = m 
     I x = Intv c   I y = Intv d   real c - d = m  (x, y)  r  (y, x)  r 
     (I x = Greater (k x)  I y = Greater (k y))  J x y = Const' e  e = m
    )}"
  { fix u I J r assume "u  region X I J r" "I x = Greater (k x)  I y = Greater (k y)"
    with A(3,4) have "intv'_elem x y u (J x y)" by force
  } note * = this
  { fix u I J r assume "u  region X I J r"
    with A(3,4) have "intv_elem x u (I x)" "intv_elem y u (I y)" by force+
  } note ** = this
  have " ?U = {u  V. u x - u y = m}"
  proof (safe, goal_cases)
    case (2 u) with **[OF this(1)] show ?case by auto
  next
    case (4 u X I J r c d)
    from this A(3,4) have "intv_elem x u (I x)" "intv_elem y u (I y)" "frac (u x) = frac (u y)" by force+
    with nat_intv_frac_decomp 4(4,5) have
      "u x = c + frac (u x)" "u y = d + frac (u y)" "frac (u x) = frac (u y)"
    by force+
    with 4(6) show ?case by linarith
  next
    case (9 u)
    from region_cover_V[OF this(1)] obtain R where R: "R  " "u  R" by auto
    then obtain I J r where R': "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
    with R' R(2) A have C:
      "intv_elem x u (I x)" "intv_elem y u (I y)" "valid_intv (k x) (I x)" "valid_intv (k y) (I y)"
    by auto
    { assume A: "I x = Greater (k x)  I y = Greater (k y)"
      obtain intv where intv:
        "valid_intv' (k y) (k x) intv" "intv'_elem x y u intv" "intv = Const' m"
      proof (cases "u x - u y < - int (k y)")
        case True
        with 9 B show ?thesis by auto
      next
        case False
        show thesis
        proof (cases " (c :: int). u x - u y = c")
          case True
          then obtain c :: int where c: "u x - u y = c" by auto
          have "valid_intv' (k y) (k x) (Const' c)" using False B(2) 9(2) c by fastforce
          moreover with c have "intv'_elem x y u (Const' c)" by auto
          moreover have "c = m" using c 9(2) by auto
          ultimately show thesis by (auto intro: that)
        next
          case False
          then have "u x - u y  " by (metis Ints_cases)
          with 9 show ?thesis by auto
        qed
      qed
      let ?J = "λ a b. if x = a  y = b then intv else J a b"
      let ?R = "region X I ?J r"
      let ?X0 = "{x  X. d. I x = Intv d}"
      have "u  ?R"
      proof (standard, goal_cases)
        case 1 from R R' show ?case by auto
      next
        case 2 from R R' show ?case by auto
      next
        case 3 show "?X0 = ?X0" by auto
      next
        case 4 from R R' show "x?X0. y?X0. (x, y)  r  frac (u x)  frac (u y)" by auto
      next
        case 5
        show ?case
        proof (clarify, goal_cases)
          case (1 a b)
          show ?case
          proof (cases "x = a  y = b")
            case True with intv show ?thesis by auto
          next
            case False with R(2) R'(1) 1 show ?thesis by force
          qed
        qed
      qed
      have "valid_region X k I ?J r"
      proof (standard, goal_cases)
        show "?X0 = ?X0" ..
        show "refl_on ?X0 r" using R' by auto
        show "trans r" using R' by auto
        show "total_on ?X0 r" using R' by auto
        show "xX. valid_intv (k x) (I x)" using R' by auto
      next
        case 6
        then show ?case
        proof (clarify, goal_cases)
          case (1 a b)
          show ?case
          proof (cases "x = a  y = b")
            case True with B intv show ?thesis by auto
          next
            case False with R'(2) 1 show ?thesis by force
          qed
        qed
      qed
      moreover then have "?R  " unfolding ℛ_def by auto
      ultimately have "?R  ?U" using intv
        apply clarify
        apply (rule exI[where x = I], rule exI[where x = ?J], rule exI[where x = r])
      using A by fastforce
      with u  region _ _ _ _ have ?case by (intro Complete_Lattices.UnionI) blast+
    } note * = this
    show ?case
    proof (cases "I x")
      case (Const c)
      show ?thesis
      proof (cases "I y", goal_cases)
        case (1 d)
        with C(1,2) Const A(2,3) 9(2) have "real c - d = m" by auto
        with Const 1 R R' show ?thesis by blast
      next
        case (Intv d)
        from Intv Const C(1,2) have range: "d < u y" "u y < d + 1" and eq: "u x = c" by auto
        from eq have "u x  " by auto
        with nat_intv_not_int[OF range] have "u x - u y  " using Ints_diff by fastforce
        with 9 show ?thesis by auto
      next
        case Greater with C * show ?thesis by auto
      qed
    next
      case (Intv c)
      show ?thesis
      proof (cases "I y", goal_cases)
        case (Const d)
        from Intv Const C(1,2) have range: "c < u x" "u x < c + 1" and eq: "u y = d" by auto
        from eq have "u y  " by auto
        with nat_intv_not_int[OF range] have "u x - u y  " using Ints_add by fastforce
        with 9 show ?thesis by auto
      next
        case (2 d)
        with Intv C have range: "c < u x" "u x < c + 1" "d < u y" "u y < d + 1" by auto
        show ?thesis
        proof (cases "(x, y)  r")
          case True
          note T = this
          show ?thesis
          proof (cases "(y, x)  r")
            case True
            with Intv 2 T R' u  R A(3,4) have "frac (u x) = frac (u y)" by force
            with nat_intv_frac_decomp[OF range(1,2)] nat_intv_frac_decomp[OF range(3,4)] have
              "u x - u y = real c - real d"
            by algebra
            with 9 have "real c - d = m" by auto
            with T True Intv 2 R R' show ?thesis by force
          next
            case False
            with Intv 2 T R' u  R A(3,4) have "frac (u x) < frac (u y)" by force
            then have
              "frac (u x - u y)  0"
            by (metis add.left_neutral diff_add_cancel frac_add frac_unique_iff less_irrefl)
            then have "u x - u y  " by (metis frac_eq_0_iff)
            with 9 show ?thesis by auto
          qed
        next
          case False
          note F = this
          show ?thesis
          proof (cases "x = y")
            case True
            with R'(2) Intv x  X have "(x, y)  r" "(y, x)  r" by (auto simp: refl_on_def)
            with Intv True R' R 9(2) show ?thesis by force
          next
            case False
            with F R'(2) Intv 2 x  X y  X have "(y, x)  r" by (fastforce simp: total_on_def)
            with F Intv 2 R' u  R A(3,4) have "frac (u x) > frac (u y)" by force
            then have
              "frac (u x - u y)  0"
            by (metis add.left_neutral diff_add_cancel frac_add frac_unique_iff less_irrefl)
            then have "u x - u y  " by (metis frac_eq_0_iff)
            with 9 show ?thesis by auto
          qed
        qed
      next
        case Greater with * C show ?thesis by force
      qed
    next
      case Greater with * C show ?thesis by force
    qed
  qed (auto intro: A simp: V_def dest: *)
  moreover have "?U  " by fastforce
  ultimately show ?thesis by blast
qed

lemma β_boundedness_lt:
  fixes m :: int
  assumes "m  k x" "x  X"
  shows " U  .  U = {u  V. u x < m}"
proof -
  note A = assms
  let ?U = "{R  .  I J r c. R = region X I J r  valid_region X k I J r 
    (I x = Const c  c < m  I x = Intv c  c < m)}"
  { fix u I J r assume "u  region X I J r"
    with A have "intv_elem x u (I x)" by force+
  } note ** = this
  have " ?U = {u  V. u x < m}"
  proof (safe, goal_cases)
    case (2 u) with **[OF this(1)] show ?case by auto
  next
    case (4 u) with **[OF this(1)] show ?case by auto
  next
    case (5 u)
    from region_cover_V[OF this(1)] obtain R where R: "R  " "u  R" by auto
    then obtain I J r where R': "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
    with R' R(2) A have C:
      "intv_elem x u (I x)" "valid_intv (k x) (I x)"
    by auto
    show ?case
    proof (cases "I x")
      case (Const c)
      with 5 C(1) have "c < m" by auto
      with R R' Const show ?thesis by blast
    next
      case (Intv c)
      with 5 C(1) have "c < m" by auto
      with R R' Intv show ?thesis by blast
    next
      case (Greater c) with 5 C A Greater show ?thesis by auto
    qed
  qed (auto intro: A simp: V_def)
  moreover have "?U  " by fastforce
  ultimately show ?thesis by blast
qed

lemma β_boundedness_gt:
  fixes m :: int
  assumes "m  k x" "x  X"
  shows " U  .  U = {u  V. u x > m}"
proof -
  note A = assms
  let ?U = "{R  .  I J r c. R = region X I J r  valid_region X k I J r 
    (I x = Const c  c > m  I x = Intv c  c  m  I x = Greater (k x))}"
  { fix u I J r assume "u  region X I J r"
    with A have "intv_elem x u (I x)" by force+
  } note ** = this
  have " ?U = {u  V. u x > m}"
  proof (safe, goal_cases)
    case (2 u) with **[OF this(1)] show ?case by auto
  next
    case (4 u) with **[OF this(1)] show ?case by auto
  next
    case (6 u) with A **[OF this(1)] show ?case by auto
  next
    case (7 u)
    from region_cover_V[OF this(1)] obtain R where R: "R  " "u  R" by auto
    then obtain I J r where R': "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
    with R' R(2) A have C:
      "intv_elem x u (I x)" "valid_intv (k x) (I x)"
    by auto
    show ?case
    proof (cases "I x")
      case (Const c)
      with 7 C(1) have "c > m" by auto
      with R R' Const show ?thesis by blast
    next
      case (Intv c)
      with 7 C(1) have "c  m" by auto
      with R R' Intv show ?thesis by blast
    next
      case (Greater c)
      with C have "k x = c" by auto
      with R R' Greater show ?thesis by blast
    qed
  qed (auto intro: A simp: V_def)
  moreover have "?U  " by fastforce
  ultimately show ?thesis by blast
qed

lemma β_boundedness_eq:
  fixes m :: int
  assumes "m  k x" "x  X"
  shows " U  .  U = {u  V. u x = m}"
proof -
  note A = assms
  let ?U = "{R  .  I J r c. R = region X I J r  valid_region X k I J r  I x = Const c  c = m}"
  have " ?U = {u  V. u x = m}"
  proof (safe, goal_cases)
    case (2 u) with A show ?case by force
  next
    case (3 u)
    from region_cover_V[OF this(1)] obtain R where R: "R  " "u  R" by auto
    then obtain I J r where R': "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
    with R' R(2) A have C: "intv_elem x u (I x)" "valid_intv (k x) (I x)" by auto
    show ?case
    proof (cases "I x")
      case (Const c)
      with 3 C(1) have "c = m" by auto
      with R R' Const show ?thesis by blast
    next
      case (Intv c)
      with C have "c < u x" "u x < c + 1" by auto
      from nat_intv_not_int[OF this] 3 show ?thesis by auto
    next
      case (Greater c)
      with C 3 A show ?thesis by auto
    qed
  qed (force intro: A simp: V_def)
  moreover have "?U  " by fastforce
  ultimately show ?thesis by blast
qed

lemma β_boundedness_diag_le:
  fixes m :: int
  assumes "- k y  m" "m  k x" "x  X" "y  X"
  shows " U  .  U = {u  V. u x - u y  m}"
proof -
  from β_boundedness_diag_eq[OF assms] β_boundedness_diag_lt[OF assms] obtain U1 U2 where A:
    "U1  " " U1 = {u  V. u x - u y < m}" "U2  " " U2 = {u  V. u x - u y = m}"
  by blast
  then have "{u  V. u x - u y  m} =  (U1  U2)" "U1  U2  " by auto
  then show ?thesis by blast
qed

lemma β_boundedness_le:
  fixes m :: int
  assumes "m  k x" "x  X"
  shows " U  .  U = {u  V. u x  m}"
proof -
  from β_boundedness_lt[OF assms] β_boundedness_eq[OF assms] obtain U1 U2 where A:
    "U1  " " U1 = {u  V. u x  < m}" "U2  " " U2 = {u  V. u x = m}"
  by blast
  then have "{u  V. u x  m} =  (U1  U2)" "U1  U2  " by auto
  then show ?thesis by blast
qed

lemma β_boundedness_ge:
  fixes m :: int
  assumes "m  k x" "x  X"
  shows " U  .  U = {u  V. u x  m}"
proof -
  from β_boundedness_gt[OF assms] β_boundedness_eq[OF assms] obtain U1 U2 where A:
    "U1  " " U1 = {u  V. u x  > m}" "U2  " " U2 = {u  V. u x = m}"
  by blast
  then have "{u  V. u x  m} =  (U1  U2)" "U1  U2  " by auto
  then show ?thesis by blast
qed

lemma β_boundedness_diag_lt':
  fixes m :: int
  shows
  "- k y  (m :: int)  m  k x  x  X  y  X  Z  {u  V. u x - u y < m}
   Approxβ Z  {u  V. u x - u y < m}"
proof (goal_cases)
  case 1
  note A = this
  from β_boundedness_diag_lt[OF A(1-4)] obtain U where U:
    "U  " "{u  V. u x - u y < m} = U"
  by auto
  from 1 clock_numbering have *: "v x > 0" "v y > 0" "v x  n" "v y  n" by auto
  have **: " c. v c = 0  False"
  proof -
    fix c assume "v c = 0"
    moreover from clock_numbering(1) have "v c > 0" by auto
    ultimately show False by auto
  qed
  let ?M = "λ i j. if (i = v x  j = v y) then Lt m else if i = j  i = 0 then Le 0 else "
  have "{u  V. u x - u y < m} = [?M]v,n" unfolding DBM_zone_repr_def DBM_val_bounded_def
  using * ** proof (auto, goal_cases)
    case (1 u c)
    with clock_numbering have "c  X" by metis
    with 1 show ?case unfolding V_def by auto
  next
    case (2 u c1 c2)
    with clock_numbering(1) have "x = c1" "y = c2" by auto
    with 2(5) show ?case by auto
  next
    case (3 u c1 c2)
    with clock_numbering(1) have "c1 = c2" by auto
    then show ?case by auto
  next
    case (4 u c1 c2)
    with clock_numbering(1) have "c1 = c2" by auto
    then show ?case by auto
  next
    case (5 u c1 c2)
    with clock_numbering(1) have "x = c1" "y = c2" by auto
    with 5(6) show ?case by auto
  next
    case (6 u)
    show ?case unfolding V_def
    proof safe
      fix c assume "c  X"
      with clock_numbering have "v c > 0" "v c  n" by auto
      with 6(6) show "u c  0" by auto
    qed
  next
    case (7 u)
    then have "dbm_entry_val u (Some x) (Some y) (Lt (real_of_int m))" by metis
    then show ?case by auto
  qed
  then have "vabstr {u  V. u x - u y < m} ?M" by auto
  moreover have "normalized ?M" unfolding normalized less_eq dbm_le_def using A v_v' by auto
  ultimately show ?thesis using apx_min[OF U(2,1)] A(5) by blast
qed

lemma β_boundedness_diag_le':
  fixes m :: int
  shows
  "- k y  (m :: int)  m  k x  x  X  y  X  Z  {u  V. u x - u y  m}
   Approxβ Z  {u  V. u x - u y  m}"
proof (goal_cases)
  case 1
  note A = this
  from β_boundedness_diag_le[OF A(1-4)] obtain U where U:
    "U  " "{u  V. u x - u y  m} = U"
  by auto
  from 1 clock_numbering have *: "v x > 0" "v y > 0" "v x  n" "v y  n" by auto
  have **: " c. v c = 0  False"
  proof -
    fix c assume "v c = 0"
    moreover from clock_numbering(1) have "v c > 0" by auto
    ultimately show False by auto
  qed
  let ?M = "λ i j. if (i = v x  j = v y) then Le m else if i = j  i = 0 then Le 0 else "
  have "{u  V. u x - u y  m} = [?M]v,n" unfolding DBM_zone_repr_def DBM_val_bounded_def
  using * **
  proof (auto, goal_cases)
    case (1 u c)
    with clock_numbering have "c  X" by metis
    with 1 show ?case unfolding V_def by auto
  next
    case (2 u c1 c2)
    with clock_numbering(1) have "x = c1" "y = c2" by auto
    with 2(5) show ?case by auto
  next
    case (3 u c1 c2)
    with clock_numbering(1) have "c1 = c2" by auto
    then show ?case by auto
  next
    case (4 u c1 c2)
    with clock_numbering(1) have "c1 = c2" by auto
    then show ?case by auto
  next
    case (5 u c1 c2)
    with clock_numbering(1) have "x = c1" "y = c2" by auto
    with 5(6) show ?case by auto
  next
    case (6 u)
    show ?case unfolding V_def
    proof safe
      fix c assume "c  X"
      with clock_numbering have "v c > 0" "v c  n" by auto
      with 6(6) show "u c  0" by auto
    qed
  next
    case (7 u)
    then have "dbm_entry_val u (Some x) (Some y) (Le (real_of_int m))" by metis
    then show ?case by auto
  qed
  then have "vabstr {u  V. u x - u y  m} ?M" by auto
  moreover have "normalized ?M" unfolding normalized less_eq dbm_le_def using A v_v' by auto
  ultimately show ?thesis using apx_min[OF U(2,1)] A(5) by blast
qed

lemma β_boundedness_lt':
  fixes m :: int
  shows
  "m  k x  x  X  Z  {u  V. u x < m}  Approxβ Z  {u  V. u x < m}"
proof (goal_cases)
  case 1
  note A = this
  from β_boundedness_lt[OF A(1,2)] obtain U where U: "U  " "{u  V. u x < m} = U" by auto
  from 1 clock_numbering have *: "v x > 0" "v x  n" by auto
  have **: " c. v c = 0  False"
  proof -
    fix c assume "v c = 0"
    moreover from clock_numbering(1) have "v c > 0" by auto
    ultimately show False by auto
  qed
  let ?M = "λ i j. if (i = v x  j = 0) then Lt m else if i = j  i = 0 then Le 0 else "
  have "{u  V. u x < m} = [?M]v,n" unfolding DBM_zone_repr_def DBM_val_bounded_def
  using * **
  proof (auto, goal_cases)
    case (1 u c)
    with clock_numbering have "c  X" by metis
    with 1 show ?case unfolding V_def by auto
  next
    case (2 u c1)
    with clock_numbering(1) have "x = c1" by auto
    with 2(4) show ?case by auto
  next
    case (3 u c)
    with clock_numbering have "c  X" by metis
    with 3 show ?case unfolding V_def by auto
  next
    case (4 u c1 c2)
    with clock_numbering(1) have "c1 = c2" by auto
    then show ?case by auto
  next
    case (5 u)
    show ?case unfolding V_def
    proof safe
      fix c assume "c  X"
      with clock_numbering have "v c > 0" "v c  n" by auto
      with 5(4) show "u c  0" by auto
    qed
  qed
  then have "vabstr {u  V. u x < m} ?M" by auto
  moreover have "normalized ?M" unfolding normalized less_eq dbm_le_def using A v_v' by auto
  ultimately show ?thesis using apx_min[OF U(2,1)] A(3) by blast
qed

lemma β_boundedness_gt':
  fixes m :: int
  shows
  "m  k x  x  X  Z  {u  V. u x > m}  Approxβ Z  {u  V. u x > m}"
proof goal_cases
  case 1
  from β_boundedness_gt[OF this(1,2)] obtain U where U: "U  " "{u  V. u x > m} = U" by auto
  from 1 clock_numbering have *: "v x > 0" "v x  n" by auto
  have **: " c. v c = 0  False"
  proof -
    fix c assume "v c = 0"
    moreover from clock_numbering(1) have "v c > 0" by auto
    ultimately show False by auto
  qed
  obtain M where "vabstr {u  V. u x > m} M" "normalized M"
  proof (cases "m  0")
    case True
    let ?M = "λ i j. if (i = 0  j = v x) then Lt (-m) else if i = j  i = 0 then Le 0 else "
    have "{u  V. u x > m} = [?M]v,n" unfolding DBM_zone_repr_def DBM_val_bounded_def
    using * **
    proof (auto, goal_cases)
      case (1 u c)
      with clock_numbering(1) have "x = c" by auto
      with 1(5) show ?case by auto
    next
      case (2 u c)
      with clock_numbering have "c  X" by metis
      with 2 show ?case unfolding V_def by auto
    next
      case (3 u c1 c2)
      with clock_numbering(1) have "c1 = c2" by auto
      then show ?case by auto
    next
      case (4 u c1 c2)
      with clock_numbering(1) have "c1 = c2" by auto
      then show ?case by auto
    next
      case (5 u)
      show ?case unfolding V_def
      proof safe
        fix c assume "c  X"
        with clock_numbering have c: "v c > 0" "v c  n" by auto
        show "u c  0"
        proof (cases "v c = v x")
          case False
          with 5(4) c show ?thesis by auto
        next
          case True
          with 5(4) c have "- u c < - m" by auto
          with m  0 show ?thesis by auto
        qed
      qed
    qed
    moreover have "normalized ?M" unfolding normalized using 1 v_v' by auto
    ultimately show ?thesis by (intro that[of ?M]) auto
  next
    case False
    then have "{u  V. u x > m} = V" unfolding V_def using x  X by auto
    with ℛ_union all_dbm that show ?thesis by auto
  qed
  with apx_min[OF U(2,1)] 1(3) show ?thesis by blast
qed

lemma obtains_dbm_le:
  fixes m :: int
  assumes "x  X" "m  k x"
  obtains M where "vabstr {u  V. u x  m} M" "normalized M"
proof -
  from assms clock_numbering have *: "v x > 0" "v x  n" by auto
  have **: " c. v c = 0  False"
  proof -
    fix c assume "v c = 0"
    moreover from clock_numbering(1) have "v c > 0" by auto
    ultimately show False by auto
  qed
  let ?M = "λ i j. if (i = v x  j = 0) then Le m else if i = j  i = 0 then Le 0 else "
  have "{u  V. u x  m} = [?M]v,n" unfolding DBM_zone_repr_def DBM_val_bounded_def
  using * **
  proof (auto, goal_cases)
    case (1 u c)
    with clock_numbering have "c  X" by metis
    with 1 show ?case unfolding V_def by auto
  next
    case (2 u c1)
    with clock_numbering(1) have "x = c1" by auto
    with 2(4) show ?case by auto
  next
    case (3 u c)
    with clock_numbering have "c  X" by metis
    with 3 show ?case unfolding V_def by auto
  next
    case (4 u c1 c2)
    with clock_numbering(1) have "c1 = c2" by auto
    then show ?case by auto
  next
    case (5 u)
    show ?case unfolding V_def
    proof safe
      fix c assume "c  X"
      with clock_numbering have "v c > 0" "v c  n" by auto
      with 5(4) show "u c  0" by auto
    qed
  qed
  then have "vabstr {u  V. u x  m} ?M" by auto
  moreover have "normalized ?M" unfolding normalized using assms v_v' by auto
  ultimately show ?thesis ..
qed


lemma β_boundedness_le':
  fixes m :: int
  shows
  "m  k x  x  X  Z  {u  V. u x  m}  Approxβ Z  {u  V. u x  m}"
proof (goal_cases)
  case 1
  from β_boundedness_le[OF this(1,2)] obtain U where U: "U  " "{u  V. u x  m} = U" by auto
  from obtains_dbm_le 1 obtain M where "vabstr {u  V. u x  m} M" "normalized M" by auto
  with apx_min[OF U(2,1)] 1(3) show ?thesis by blast
qed

lemma obtains_dbm_ge:
  fixes m :: int
  assumes "x  X" "m  k x"
  obtains M where "vabstr {u  V. u x  m} M" "normalized M"
proof -
  from assms clock_numbering have *: "v x > 0" "v x  n" by auto
  have **: " c. v c = 0  False"
  proof -
    fix c assume "v c = 0"
    moreover from clock_numbering(1) have "v c > 0" by auto
    ultimately show False by auto
  qed
  obtain M where "vabstr {u  V. u x  m} M" "normalized M"
  proof (cases "m  0")
    case True
    let ?M = "λ i j. if (i = 0  j = v x) then Le (-m) else if i = j  i = 0 then Le 0 else "
    have "{u  V. u x  m} = [?M]v,n" unfolding DBM_zone_repr_def DBM_val_bounded_def
    using * **
    proof (auto, goal_cases)
      case (1 u c)
      with clock_numbering(1) have "x = c" by auto
      with 1(5) show ?case by auto
    next
      case (2 u c)
      with clock_numbering have "c  X" by metis
      with 2 show ?case unfolding V_def by auto
    next
      case (3 u c1 c2)
      with clock_numbering(1) have "c1 = c2" by auto
      then show ?case by auto
    next
      case (4 u c1 c2)
      with clock_numbering(1) have "c1 = c2" by auto
      then show ?case by auto
    next
      case (5 u)
      show ?case unfolding V_def
      proof safe
        fix c assume "c  X"
        with clock_numbering have c: "v c > 0" "v c  n" by auto
        show "u c  0"
        proof (cases "v c = v x")
          case False
          with 5(4) c show ?thesis by auto
        next
          case True
          with 5(4) c have "- u c  - m" by auto
          with m  0 show ?thesis by auto
        qed
      qed
    qed
    moreover have "normalized ?M" unfolding normalized using assms v_v' by auto
    ultimately show ?thesis by (intro that[of ?M]) auto
  next
    case False
    then have "{u  V. u x  m} = V" unfolding V_def using x  X by auto
    with ℛ_union all_dbm that show ?thesis by auto
  qed
  then show ?thesis ..
qed

lemma β_boundedness_ge':
  fixes m :: int
  shows "m  k x  x  X  Z  {u  V. u x  m}  Approxβ Z  {u  V. u x  m}"
proof (goal_cases)
  case 1
  from β_boundedness_ge[OF this(1,2)] obtain U where U: "U  " "{u  V. u x  m} = U" by auto
  from obtains_dbm_ge 1 obtain M where "vabstr {u  V. u x  m} M" "normalized M" by auto
  with apx_min[OF U(2,1)] 1(3) show ?thesis by blast
qed

end

end

Theory Regions

chapter ‹The Classic Construction for Decidability›

theory Regions
imports Timed_Automata Misc
begin

text ‹
  The following is a formalization of regions in the correct version of Patricia Bouyer et al.
›

section ‹Definition of Regions›

type_synonym 'c ceiling = "('c  nat)"

datatype intv =
  Const nat |
  Intv nat |
  Greater nat

type_synonym t = real

instantiation real :: time
begin
  instance proof
    fix x y :: real assume "x < y"
    then show " z > x. z < y" using Rats_cases using dense_order_class.dense by blast
  next
    have "(1:: real)  0" by auto
    then show "x. (x::real)  0" by blast
  qed
end

inductive valid_intv :: "nat  intv  bool"
where
  "0  d  d  c  valid_intv c (Const d)" |
  "0  d  d < c   valid_intv c (Intv d)" |
  "valid_intv c (Greater c)"

inductive intv_elem :: "'c  ('c,t) cval  intv  bool"
where
  "u x = d  intv_elem x u (Const d)" |
  "d < u x  u x < d + 1  intv_elem x u (Intv d)" |
  "c < u x  intv_elem x u (Greater c)"

abbreviation "total_preorder r  refl r  trans r"

inductive valid_region :: "'c set  ('c  nat)  ('c  intv)  'c rel  bool"
where
  "X0 = {x  X.  d. I x = Intv d}; refl_on X0 r; trans r; total_on X0 r;  x  X. valid_intv (k x) (I x)
   valid_region X k I r"

inductive_set region for X I r
where
  " x  X. u x  0   x  X. intv_elem x u (I x)  X0 = {x  X.  d. I x = Intv d} 
    x  X0.  y  X0. (x, y)  r  frac (u x)  frac (u y)
   u  region X I r"

text ‹Defining the unique element of a partition that contains a valuation›

definition part ("[_]⇩_" [61,61] 61) where "part v   THE R. R    v  R"

inductive_set Succ for  R where
  "u  R  R    R'    t  0  R' = [u  t]⇩  R'  Succ  R"

text ‹
  First we need to show that the set of regions is a partition of the set of all clock
  assignments. This property is only claimed by P. Bouyer.
›

inductive_cases[elim!]: "intv_elem x u (Const d)"
inductive_cases[elim!]: "intv_elem x u (Intv d)"
inductive_cases[elim!]: "intv_elem x u (Greater d)"
inductive_cases[elim!]: "valid_intv c (Greater d)"
inductive_cases[elim!]: "valid_intv c (Const d)"
inductive_cases[elim!]: "valid_intv c (Intv d)"

declare valid_intv.intros[intro]
declare intv_elem.intros[intro]
declare Succ.intros[intro]

declare Succ.cases[elim]

declare region.cases[elim]
declare valid_region.cases[elim]

section ‹Basic Properties›

text ‹First we show that all valid intervals are distinct.›

lemma valid_intv_distinct:
  "valid_intv c I  valid_intv c I'  intv_elem x u I  intv_elem x u I'  I = I'"
by (cases I; cases I'; auto)

text ‹From this we show that all valid regions are distinct.›

lemma valid_regions_distinct:
  "valid_region X k I r  valid_region X k I' r'  v  region X I r  v  region X I' r'
   region X I r = region X I' r'"
proof goal_cases
  case A: 1
  { fix x assume x: "x  X"
    with A(1) have "valid_intv (k x) (I x)" by auto
    moreover from A(2) x have "valid_intv (k x) (I' x)" by auto
    moreover from A(3) x have "intv_elem x v (I x)" by auto
    moreover from A(4) x have "intv_elem x v (I' x)" by auto
    ultimately have "I x = I' x" using valid_intv_distinct by fastforce
  } note * = this
  from A show ?thesis
  proof (safe, goal_cases)
    case A: (1 u)
    have "intv_elem x u (I' x)" if "x  X" for x using A(5) * that by auto
    then have B: " x  X. intv_elem x u (I' x)" by auto
    let ?X0 = "{x  X.  d. I' x = Intv d}"
    { fix x y assume x: "x  ?X0" and y: "y  ?X0"
      have "(x, y)  r'  frac (u x)  frac (u y)"
      proof
        assume "frac (u x)  frac (u y)"
        with A(5) x y * have "(x,y)  r" by auto
        with A(3) x y * have "frac (v x)  frac (v y)" by auto
        with A(4) x y   show "(x,y)  r'" by auto
      next
        assume "(x,y)  r'"
        with A(4) x y   have "frac (v x)  frac (v y)" by auto
        with A(3) x y * have "(x,y)  r" by auto
        with A(5) x y * show "frac (u x)  frac (u y)" by auto
      qed
    }
    then have *: " x  ?X0.  y  ?X0. (x, y)  r'  frac (u x)  frac (u y)" by auto
    from A(5) have "xX. 0  u x" by auto
    from region.intros[OF this B _ *] show ?case by auto
  next
    case A: (2 u)
    have "intv_elem x u (I x)" if "x  X" for x using * A(5) that by auto
    then have B: " x  X. intv_elem x u (I x)" by auto
    let ?X0 = "{x  X.  d. I x = Intv d}"
    { fix x y assume x: "x  ?X0" and y: "y  ?X0"
      have "(x, y)  r  frac (u x)  frac (u y)"
      proof
        assume "frac (u x)  frac (u y)"
        with A(5) x y * have "(x,y)  r'" by auto
        with A(4) x y * have "frac (v x)  frac (v y)" by auto
        with A(3) x y   show "(x,y)  r" by auto
      next
        assume "(x,y)  r"
        with A(3) x y   have "frac (v x)  frac (v y)" by auto
        with A(4) x y * have "(x,y)  r'" by auto
        with A(5) x y * show "frac (u x)  frac (u y)" by auto
      qed
    }
    then have *:" x  ?X0.  y  ?X0. (x, y)  r  frac (u x)  frac (u y)" by auto
    from A(5) have "xX. 0  u x" by auto
    from region.intros[OF this B _ *] show ?case by auto
  qed
qed

lemma ℛ_regions_distinct:
  " = {region X I r | I r. valid_region X k I r}; R  ; v  R; R'  ; R  R'  v  R'"
using valid_regions_distinct by blast

text ‹
  Secondly, we also need to show that every valuations belongs to a region which is part of
  the partition.
›

definition intv_of :: "nat  t  intv" where
  "intv_of k c 
    if (c > k) then Greater k
    else if ( x :: nat. x = c) then (Const (nat (floor c)))
    else (Intv (nat (floor c)))"

lemma region_cover:
  " x  X. u x  0   R. R  {region X I r | I r. valid_region X k I r}  u  R"
proof (standard, standard)
  assume assm: " x  X. 0  u x"
  let ?I = "λ x. intv_of (k x) (u x)"
  let ?X0 = "{x  X.  d. ?I x = Intv d}"
  let ?r = "{(x,y). x  ?X0  y  ?X0  frac (u x)  frac (u y)}"
  show "u  region X ?I ?r"
  proof (standard, auto simp: assm, goal_cases)
    case (1 x)
    thus ?case unfolding intv_of_def
    proof (auto, goal_cases)
      case A: (1 a)
      from A(2) have "u x = u x" by (metis of_int_floor_cancel of_int_of_nat_eq) 
      with assm A(1) have "u x = real (nat u x)" by auto
      then show ?case by auto
    next
      case A: 2
      from A(1,2) have "real (nat u x) < u x"
      by (metis assm floor_less_iff int_nat_eq less_eq_real_def less_irrefl not_less
                of_int_of_nat_eq of_nat_0)
      moreover from assm have "u x < real (nat (u x) + 1)" by linarith
      ultimately show ?case by auto
    qed
  qed
  have "valid_intv (k x) (intv_of (k x) (u x))" if "x  X" for x using that
  proof (auto simp: intv_of_def, goal_cases)
    case 1 then show ?case by (intro valid_intv.intros(1)) (auto, linarith)
  next
    case 2
    then show ?case using assm floor_less_iff nat_less_iff
    by (intro valid_intv.intros(2)) fastforce+
  qed
  then have "valid_region X k ?I ?r"
  by (intro valid_region.intros) (auto simp: refl_on_def trans_def total_on_def)
  then show "region X ?I ?r  {region X I r | I r. valid_region X k I r}" by auto
qed

lemma intv_not_empty:
  obtains d where "intv_elem x (v(x := d)) (I x)"
proof (cases "I x", goal_cases)
  case (1 d)
  then have "intv_elem x (v(x := d)) (I x)" by auto
  with 1 show ?case by auto
next
  case (2 d)
  then have "intv_elem x (v(x := d + 0.5)) (I x)" by auto
  with 2 show ?case by auto
next
  case (3 d)
  then have "intv_elem x (v(x := d + 0.5)) (I x)" by auto
  with 3 show ?case by auto
qed

fun get_intv_val :: "intv  real  real"
where
  "get_intv_val (Const d)   _ = d" |
  "get_intv_val (Intv d)    f = d + f"  |
  "get_intv_val (Greater d) _ = d + 1"

lemma region_not_empty_aux:
  assumes "0 < f" "f < 1" "0 < g" "g < 1"
  shows "frac (get_intv_val (Intv d) f)  frac (get_intv_val (Intv d') g)  f  g"
using assms by (simp, metis frac_eq frac_nat_add_id less_eq_real_def) 

lemma region_not_empty:
  assumes "finite X" "valid_region X k I r"
  shows " u. u  region X I r"
proof -
  let ?X0 = "{x  X. d. I x = Intv d}"
  obtain f :: "'a  nat" where f:
    "x?X0. y?X0. f x  f y  (x, y)  r"
     apply (rule finite_total_preorder_enumeration)
         apply (subgoal_tac "finite ?X0")
          apply assumption
  using assms by auto
  let ?M = "if ?X0  {} then Max {f x | x. x  ?X0} else 1"
  let ?f = "λ x. (f x + 1) / (?M + 2)"
  let ?v = "λ x. get_intv_val (I x) (if x  ?X0 then ?f x else 1)"
  have frac_intv: "x?X0. 0 < ?f x  ?f x < 1"
  proof (standard, goal_cases)
    case (1 x)
    then have *: "?X0  {}" by auto
    have "f x  Max {f x | x. x  ?X0}" apply (rule Max_ge) using ‹finite X 1 by auto
    with 1 show ?case by auto
  qed
  with region_not_empty_aux have *:
    "x?X0. y?X0. frac (?v x)  frac (?v y)  ?f x  ?f y"
  by force
  have "x?X0. y?X0. ?f x  ?f y  f x  f y" by (simp add: divide_le_cancel)+
  with f have "x?X0. y?X0. ?f x  ?f y  (x, y)  r" by auto
  with * have frac_order: "x?X0. y?X0. frac (?v x)  frac (?v y)  (x, y)  r" by auto
  have "?v  region X I r"
  proof standard
    show "xX. intv_elem x ?v (I x)"
    proof (standard, case_tac "I x", goal_cases)
      case (2 x d)
      then have *: "x  ?X0" by auto
      with frac_intv have "0 < ?f x" "?f x < 1" by auto
      moreover from 2 have "?v x = d + ?f x" by auto
      ultimately have "?v x < d + 1  d < ?v x" by linarith
      then show "intv_elem x ?v (I x)" by (subst 2(2)) (intro intv_elem.intros(2), auto)
    qed auto
  next
    show "xX. 0  get_intv_val (I x) (if x  ?X0 then ?f x else 1)"
    by (standard, case_tac "I x") auto
  next
    show "{x  X. d. I x = Intv d} = {x  X. d. I x = Intv d}" ..
  next  
    from frac_order show "x?X0. y?X0. ((x, y)  r) = (frac (?v x)  frac (?v y))" by blast
  qed
  then show ?thesis by auto
qed

text ‹
  Now we can show that there is always exactly one region a valid valuation belongs to.
›

lemma regions_partition:
  " = {region X I r | I r. valid_region X k I r}  x  X. 0  u x  ∃! R  . u  R"
proof (goal_cases)
  case 1
  note A = this
  with region_cover[OF A(2)] obtain R where R: "R    u  R" by fastforce
  moreover have "R' = R" if "R'    u  R'" for R'
  using that R valid_regions_distinct unfolding A(1) by blast
  ultimately show ?thesis by auto
qed

lemma region_unique:
  " = {region X I r | I r. valid_region X k I r}  u  R  R    [u]⇩ = R"
proof (goal_cases)
  case 1
  note A = this
  from A obtain I r where *: "valid_region X k I r" "R = region X I r" "u  region X I r" by auto
  from this(3) have "xX. 0  u x" by auto
  from theI'[OF regions_partition[OF A(1) this]] A(1) obtain I' r' where
    v: "valid_region X k I' r'" "[u]⇩ = region X I' r'" "u  region X I' r'"
  unfolding part_def by auto
  from valid_regions_distinct[OF *(1) v(1) *(3) v(3)] v(2) *(2) show ?case by auto
qed

lemma regions_partition':
  " = {region X I r | I r. valid_region X k I r}  xX. 0  v x  xX. 0  v' x  v'  [v]⇩
   [v']⇩ = [v]⇩"
proof (goal_cases)
  case 1
  note A = this
  from theI'[OF regions_partition[OF A(1,2)]] A(1,4) obtain I r where
    v: "valid_region X k I r" "[v]⇩ = region X I r" "v'  region X I r"
  unfolding part_def by auto
  from theI'[OF regions_partition[OF A(1,3)]] A(1) obtain I' r' where
    v': "valid_region X k I' r'" "[v']⇩ = region X I' r'" "v'  region X I' r'"
  unfolding part_def by auto
  from valid_regions_distinct[OF v'(1) v(1) v'(3) v(3)] v(2) v'(2) show ?case by simp
qed

lemma regions_closed:
  " = {region X I r | I r. valid_region X k I r}  R    v  R  t  0  [v  t]⇩  "
proof goal_cases
  case A: 1
  then obtain I r where "v  region X I r" by auto
  from this(1) have " x  X. v x  0" by auto
  with A(4) have " x  X. (v  t) x  0" unfolding cval_add_def by simp
  from regions_partition[OF A(1) this] obtain R' where "R'  " "(v  t)  R'" by auto
  with region_unique[OF A(1) this(2,1)] show ?case by auto
qed

lemma regions_closed':
  " = {region X I r | I r. valid_region X k I r}  R    v  R  t  0  (v  t)  [v  t]⇩"
proof goal_cases
  case A: 1
  then obtain I r where "v  region X I r" by auto
  from this(1) have " x  X. v x  0" by auto
  with A(4) have " x  X. (v  t) x  0" unfolding cval_add_def by simp
  from regions_partition[OF A(1) this] obtain R' where "R'  " "(v  t)  R'" by auto
  with region_unique[OF A(1) this(2,1)] show ?case by auto
qed

lemma valid_regions_I_cong:
  "valid_region X k I r   x  X. I x = I' x  region X I r = region X I' r  valid_region X k I' r"
proof (safe, goal_cases)
  case (1 v)
  note A = this
  then have [simp]:" x. x  X  I' x = I x" by metis
  show ?case
  proof (standard, goal_cases)
    case 1
    from A(3) show ?case by auto
  next
    case 2
    from A(3) show ?case by auto
  next
    case 3
    show "{x  X. d. I x = Intv d} = {x  X. d. I' x = Intv d}" by auto
  next
    case 4
    let ?X0 = "{x  X. d. I x = Intv d}"
    from A(3) show " x  ?X0.  y  ?X0. ((x, y)  r) = (frac (v x)  frac (v y))" by auto
  qed
next
  case (2 v)
  note A = this
  then have [simp]:" x. x  X  I' x = I x" by metis
  show ?case
  proof (standard, goal_cases)
    case 1
    from A(3) show ?case by auto
  next
    case 2
    from A(3) show ?case by auto
  next
    case 3
    show "{x  X. d. I' x = Intv d} = {x  X. d. I x = Intv d}" by auto
  next
    case 4
    let ?X0 = "{x  X. d. I' x = Intv d}"
    from A(3) show " x  ?X0.  y  ?X0. ((x, y)  r) = (frac (v x)  frac (v y))" by auto
  qed
next
  case 3
  note A = this
  then have [simp]:" x. x  X  I' x = I x" by metis
  show ?case
   apply rule
       apply (subgoal_tac "{x  X. d. I x = Intv d} = {x  X. d. I' x = Intv d}")
        apply assumption
  using A by auto
qed

fun intv_const :: "intv  nat"
where
  "intv_const (Const d) = d" |
  "intv_const (Intv d) = d"  |
  "intv_const (Greater d) = d"

lemma finite_ℛ:
  notes [[simproc add: finite_Collect]] finite_subset[intro]
  fixes X k
  defines "  {region X I r | I r. valid_region X k I r}"
  assumes "finite X"
  shows "finite "
proof -
  { fix I r assume A: "valid_region X k I r"
    let ?X0 = "{x  X. d. I x = Intv d}"
    from A have "refl_on ?X0 r" by auto
    then have "r  X × X" by (auto simp: refl_on_def)
    then have "r  Pow (X × X)" by auto
  }
  then have "{r. I. valid_region X k I r}  Pow (X × X)" by auto
  with ‹finite X have fin: "finite {r. I. valid_region X k I r}" by auto
  let ?m = "Max {k x | x. x  X}"
  let ?I = "{intv. intv_const intv  ?m}"
  let ?fin_map = "λ I. x. (x  X  I x  ?I)  (x  X  I x = Const 0)"
  let ?ℛ = "{region X I r | I r. valid_region X k I r  ?fin_map I}"
  have "?I = (Const ` {d. d  ?m})  (Intv ` {d. d  ?m})  (Greater ` {d. d  ?m})"
  by auto (case_tac x, auto)
  then have "finite ?I" by auto
  from finite_set_of_finite_funs[OF ‹finite X this] have "finite {I. ?fin_map I}" .
  with fin have "finite {(I, r). valid_region X k I r  ?fin_map I}"
  by (fastforce intro: pairwise_finiteI finite_ex_and1 frac_add_le_preservation del: finite_subset)
  then have "finite ?ℛ" by fastforce
  moreover have "  ?ℛ"
  proof
    fix R assume R: "R  "
    then obtain I r where I: "R = region X I r" "valid_region X k I r" unfolding ℛ_def by auto
    let ?I = "λ x. if x  X then I x else Const 0"
    let ?R = "region X ?I r"
    from valid_regions_I_cong[OF I(2)] I have "R = ?R" "valid_region X k ?I r" by auto
    moreover have "x. x  X  ?I x = Const 0" by auto
    moreover have "x. x  X  intv_const (I x)  ?m"
    proof auto
      fix x assume x: "x  X"
      with I(2) have "valid_intv (k x) (I x)" by auto
      moreover from ‹finite X x have "k x  ?m" by (auto intro: Max_ge)
      ultimately  show "intv_const (I x)  Max {k x |x. x  X}" by (cases "I x") auto
    qed
    ultimately show "R  ?ℛ" by force
  qed
  ultimately show "finite " by blast
qed

lemma SuccI2:
  " = {region X I r | I r. valid_region X k I r}  v  R  R    t  0  R' = [v  t]⇩
   R'  Succ  R"
proof goal_cases
  case A: 1
  from Succ.intros[OF A(2) A(3) regions_closed[OF A(1,3,2,4)] A(4)] A(5) show ?case by auto
qed


section ‹Set of Regions›

text ‹
  The first property Bouyer shows is that these regions form a 'set of regions'.
›

text ‹
  For the unbounded region in the upper right corner, the set of successors only
  contains itself.
›

lemma Succ_refl:
  " = {region X I r |I r. valid_region X k I r}  finite X  R    R  Succ  R"
proof goal_cases
  case A: 1
  then obtain I r where R: "valid_region X k I r" "R = region X I r" by auto
  with A region_not_empty obtain v where v: "v  region X I r" by metis
  with R have *: "(v  0)  R" unfolding cval_add_def by auto
  from regions_closed'[OF A(1,3-)] v R have "(v  0)  [v  0]⇩" by auto
  from region_unique[OF A(1) * A(3)] A(3) v[unfolded R(2)[symmetric]] show ?case by auto
qed

lemma Succ_refl':
  " = {region X I r |I r. valid_region X k I r}  finite X   x  X.  c. I x = Greater c
   region X I r    Succ  (region X I r) = {region X I r}"
proof goal_cases
  case A: 1
  have *: "(v  t)  region X I r" if v: "v  region X I r" and t: "t  0" for v and t :: t
  proof ((rule region.intros), auto, goal_cases)
    case 1
    with v t show ?case unfolding cval_add_def by auto
  next
    case (2 x)
    with A obtain c where c: "I x = Greater c" by auto
    with v 2 have "v x > c" by fastforce
    with t have "v x + t > c" by auto
    then have "(v  t) x > c" by (simp add: cval_add_def)
    from intv_elem.intros(3)[of c "v  t", OF this] c show ?case by auto
  next
    case (3 x)
    from this(1) A obtain c where "I x = Greater c" by auto
    with 3(2) show ?case by auto
  next
    case (4 x)
    from this(1) A obtain c where "I x = Greater c" by auto
    with 4(2) show ?case by auto
  qed
  show ?case
  proof (standard, standard)
    fix R assume R: "R  Succ  (region X I r)"
    then obtain v t where v:
      "v  region X I r" "R = [v  t]⇩" "R  " "t  0"
    by (cases rule: Succ.cases) auto
    from v(1) have **: "x  X. 0  v x" by auto
    with v(4) have "x  X. 0  (v  t) x" unfolding cval_add_def by auto
    from *[OF v(1,4)] regions_partition'[OF A(1) ** this] region_unique[OF A(1) v(1) A(4)] v(2)
    show "R  {region X I r}" by auto
  next
    from A(4) obtain I' r' where R': "region X I r = region X I' r'" "valid_region X k I' r'"
    unfolding A(1) by auto
    with region_not_empty[OF A(2) this(2)] obtain v where v: "v  region X I r" by auto
    from region_unique[OF A(1) this A(4)] have *: "[v  0]⇩ = region X I r"
    unfolding cval_add_def by auto
    with v A(4) have "[v  0]⇩  Succ  (region X I r)" by (intro Succ.intros; auto)
    with * show "{region X I r}  Succ  (region X I r)" by auto
  qed
qed

text ‹
  Defining the closest successor of a region. Only exists if at least one interval is upper-bounded.
›

definition
  "succ  R =
  (SOME R'. R'  Succ  R  ( u  R.  t  0. (u  t)  R  ( t'  t. (u  t')  R'  0  t')))"

inductive isConst :: "intv  bool"
where
  "isConst (Const _)"

inductive isIntv :: "intv  bool"
where
  "isIntv (Intv _)"

inductive isGreater :: "intv  bool"
where
  "isGreater (Greater _)"

declare isIntv.intros[intro!] isConst.intros[intro!] isGreater.intros[intro!]

declare isIntv.cases[elim!] isConst.cases[elim!] isGreater.cases[elim!]

text ‹
  What Bouyer states at the end. However, we have to be a bit more precise than in her statement.
›

lemma closest_prestable_1:
  fixes I X k r
  defines "  {region X I r |I r. valid_region X k I r}"
  defines "R  region X I r"
  defines "Z  {x  X .  c. I x = Const c}"
  assumes "Z  {}"
  defines "I' λ x. if x  Z then I x else if intv_const (I x) = k x then Greater (k x) else Intv (intv_const (I x))"
  defines "r'  r  {(x,y) . x  Z  y  X  intv_const (I x) < k x  isIntv (I' y)}"
  assumes "finite X"
  assumes "valid_region X k I r"
  shows   " v  R.  t>0. t't. (v  t')  region X I' r'  t'  0"
  and     " v  region X I' r'.  t0. (v  t)  R"
  and     " x  X. ¬ isConst (I' x)"
  and     " v  R.  t < 1.  t'  0. (v  t')  region X I' r'
            {x. x  X  ( c. I x = Intv c  v x + t  c + 1)}
                = {x. x  X  ( c. I' x = Intv c  (v  t') x + (t - t')  c + 1)}"
proof (safe, goal_cases)
  fix v assume v: "v  R" fix t :: t assume t: "0 < t"
  have elem: "intv_elem x v (I x)" if x: "x  X" for x using v x unfolding R_def by auto
  have *: "(v  t)  region X I' r'" if A: " x  X. ¬ isIntv (I x)" and t: "t > 0" "t < 1" for t
  proof (standard, goal_cases)
    case 1
    from v have " x  X. v x  0" unfolding R_def by auto
    with t show ?case unfolding cval_add_def by auto
  next
    case 2
    show ?case
    proof (standard, case_tac "I x", goal_cases)
      case (1 x c)
      with elem[OF x  X] have "v x = c" by auto
      show ?case
      proof (cases "intv_const (I x) = k x", auto simp: 1 I'_def Z_def, goal_cases)
        case 1
        with v x = c have "v x = k x" by auto
        with t show ?case by (auto simp: cval_add_def)
      next
        case 2
        from assms(8) 1 have "c  k x" by (cases rule: valid_region.cases) auto
        with 2 have "c < k x" by linarith
        from t v x = c show ?case by (auto simp: cval_add_def)
      qed
    next
      case (2 x c)
      with A show ?case by auto
    next
      case (3 x c)
      then have "I' x = Greater c" unfolding I'_def Z_def by auto
      with t 3 elem[OF x  X] show ?case by (auto simp: cval_add_def)
    qed
  next
    case 3 show "{x  X. d. I' x = Intv d} = {x  X. d. I' x = Intv d}" ..
  next
    case 4
    let ?X0' = "{x  X. d. I' x = Intv d}"
    show "x?X0'. y?X0'. ((x, y)  r') = (frac ((v  t) x)  frac ((v  t) y))"
    proof (safe, goal_cases)
      case (1 x y d d')
      note B = this
      have "x  Z" apply (rule ccontr) using A B by (auto simp: I'_def)
      with elem[OF B(1)] have "frac (v x) = 0 " unfolding Z_def by auto
      with frac_distr[of t "v x"] t have *: "frac (v x + t) = t" by auto
      have "y  Z" apply (rule ccontr) using A B by (auto simp: I'_def)
      with elem[OF B(3)] have "frac (v y) = 0 " unfolding Z_def by auto
      with frac_distr[of t "v y"] t have "frac (v y + t) = t" by auto
      with * show ?case unfolding cval_add_def by auto
    next
      case B: (2 x)
      have "x  Z" apply (rule ccontr) using A B by (auto simp: I'_def)
      with B have "intv_const (I x)  k x" unfolding I'_def by auto
      with B(1) assms(8) have "intv_const (I x) < k x" by (fastforce elim!: valid_intv.cases)
      with B x  Z show ?case unfolding r'_def by auto
    qed
  qed
  let ?S = "{1 - frac (v x) | x. x  X  isIntv (I x)}"
  let ?t = "Min ?S"
  { assume A: " x  X. isIntv (I x)"
    from ‹finite X have "finite ?S" by auto
    from A have "?S  {}" by auto
    from Min_in[OF ‹finite ?S this] obtain x where
      x: "x  X" "isIntv (I x)" "?t = 1 - frac (v x)"
    by force
    have "frac (v x) < 1" by (simp add: frac_lt_1)
    then have "?t > 0" by (simp add: x(3))
    then have "?t / 2 > 0" by auto
    from x(2) obtain c where "I x = Intv c" by (auto)
    with elem[OF x(1)] have v_x: "c < v x" "v x < c + 1" by auto
    from nat_intv_frac_gt0[OF this] have "frac (v x) > 0" .
    with x(3) have "?t < 1" by auto
    { fix t :: t assume t: "0 < t" "t  ?t / 2"
      { fix y assume "y  X" "isIntv (I y)"
        then have "1 - frac (v y)  ?S" by auto
        from Min_le[OF ‹finite ?S this] ?t > 0 t have "t  < 1 - frac (v y)" by linarith
      } note frac_bound = this
      have "(v  t)  region X I' r'"
      proof (standard, goal_cases)
        case 1
        from v have " x  X. v x  0" unfolding R_def by auto
        with ?t > 0 t show ?case unfolding cval_add_def by auto
      next
        case 2
        show ?case
        proof (standard, case_tac "I x", goal_cases)
          case A: (1 x c)
          with elem[OF x  X] have "v x = c" by auto
          show ?case
          proof (cases "intv_const (I x) = k x", auto simp: A I'_def Z_def, goal_cases)
            case 1
            with v x = c have "v x = k x" by auto
            with ?t > 0 t show ?case by (auto simp: cval_add_def)
          next
            case 2
            from assms(8) A have "c  k x" by (cases rule: valid_region.cases) auto
            with 2 have "c < k x" by linarith
            from v x = c ?t < 1 t show ?case
            by (auto simp: cval_add_def)
          qed
        next
          case (2 x c)
          with elem[OF x  X] have v: "c < v x" "v x < c + 1" by auto
          with ?t > 0 have "c < v x + (?t / 2)" by auto
          from 2 have "I' x = I x" unfolding I'_def Z_def by auto
          from frac_bound[OF 2(1)] 2(2) have "t  < 1 - frac (v x)" by auto
          from frac_add_le_preservation[OF v(2) this] t v(1) 2 show ?case
          unfolding cval_add_def I' x = I x by auto
        next
          case (3 x c)
          then have "I' x = Greater c" unfolding I'_def Z_def by auto
          with 3 elem[OF x  X] t show ?case
          by (auto simp: cval_add_def)
        qed
      next
        case 3 show "{x  X. d. I' x = Intv d} = {x  X. d. I' x = Intv d}" ..
      next
        case 4
        let ?X0  = "{x  X. d. I x = Intv d}"
        let ?X0' = "{x  X. d. I' x = Intv d}"
        show "x?X0'. y?X0'. ((x, y)  r') = (frac ((v  t) x)  frac ((v  t) y))"
        proof (safe, goal_cases)
          case (1 x y d d')
          note B = this
          show ?case
          proof (cases "x  Z")
            case False
            note F = this
            show ?thesis
            proof (cases "y  Z")
              case False
              with F B have *: "x  ?X0" "y  ?X0" unfolding I'_def by auto
              from B(5) show ?thesis unfolding r'_def
              proof (safe, goal_cases)
                case 1
                with v * have le: "frac (v x) <= frac (v y)" unfolding R_def by auto
                from frac_bound * have "t < 1 - frac (v x)" "t < 1 - frac (v y)" by fastforce+
                with frac_distr t have
                  "frac (v x) + t = frac (v x + t)" "frac (v y) + t = frac (v y + t)"
                by simp+
                with le show ?case unfolding cval_add_def by fastforce
              next
                case 2
                from this(1) elem have **: "frac (v x) = 0" unfolding Z_def by force
                from 2(4) obtain c where "I' y = Intv c" by (auto )
                then have "y  Z  I y = Intv c" unfolding I'_def by presburger
                then show ?case
                proof
                  assume "y  Z"
                  with elem[OF 2(2)] have ***: "frac (v y) = 0" unfolding Z_def by force
                  show ?thesis by (simp add: ** *** frac_add cval_add_def)
                next
                  assume A: "I y = Intv c"
                  have le: "frac (v x) <= frac (v y)" by (simp add: **)
                  from frac_bound * have "t < 1 - frac (v x)" "t < 1 - frac (v y)" by fastforce+
                  with 2 t have 
                    "frac (v x) + t = frac (v x + t)" "frac (v y) + t = frac (v y + t)"
                  using F by blast+
                  with le show ?case unfolding cval_add_def by fastforce
                qed
              qed
            next
              case True
              then obtain d' where d': "I y = Const d'" unfolding Z_def by auto
              from B(5) show ?thesis unfolding r'_def
              proof (safe, goal_cases)
                case 1
                from d' have "y  ?X0" by auto
                moreover from assms(8) have "refl_on ?X0 r" by auto
                ultimately show ?case unfolding refl_on_def using 1 by auto
              next
                case 2
                with F show ?case by simp
              qed
            qed
          next
            case True
            with elem have **: "frac (v x) = 0" unfolding Z_def by force
            from B(4) have "y  Z  I y = Intv d'" unfolding I'_def by presburger
            then show ?thesis
            proof
              assume "y  Z"
              with elem[OF B(3)] have ***: "frac (v y) = 0" unfolding Z_def by force
              show ?thesis by (simp add: ** *** frac_add cval_add_def)
            next
              assume A: "I y = Intv d'"
              with B(3) have "y  ?X0" by auto
              with frac_bound have "t < 1 - frac (v y)" by fastforce+
              moreover from ** ?t < 1 have "?t / 2 < 1 - frac (v x)" by linarith
              ultimately have
                "frac (v x) + t = frac (v x + t)" "frac (v y) + t = frac (v y + t)"
              using frac_distr t by simp+
              moreover have "frac (v x) <= frac (v y)" by (simp add: **)
              ultimately show ?thesis unfolding cval_add_def by fastforce
            qed
          qed
        next
          case B: (2 x y d d')
          show ?case
          proof (cases "x  Z", goal_cases)
            case True
            with B(1,2) have "intv_const (I x)  k x" unfolding I'_def by auto
            with B(1) assms(8) have "intv_const (I x) < k x" by (fastforce elim!: valid_intv.cases)
            with B True show ?thesis unfolding r'_def by auto
          next
            case (False)
            with B(1,2) have x_intv: "isIntv (I x)" unfolding Z_def I'_def by auto
            show ?thesis
            proof (cases "y  Z")
              case False
              with B(3,4) have y_intv: "isIntv (I y)" unfolding Z_def I'_def by auto
              with frac_bound x_intv B(1,3) have "t < 1 - frac (v x)" "t < 1 - frac (v y)" by auto
              from frac_add_leD[OF _ this] B(5) t have
                "frac (v x)  frac (v y)"
              by (auto simp: cval_add_def)
              with v assms(2) B(1,3) x_intv y_intv have "(x, y)  r" by (auto )
              then show ?thesis by (simp add: r'_def)
            next
              case True
              from frac_bound x_intv B(1) have b: "t < 1 - frac (v x)" by auto
              from x_intv obtain c where "I x = Intv c" by auto
              with elem[OF x  X] have v: "c < v x" "v x < c + 1" by auto
              from True elem[OF y  X] have *: "frac (v y) = 0" unfolding Z_def by auto
              with t ?t < 1 floor_frac_add_preservation'[of t "v y"] have
                "floor (v y + t) = floor (v y)"
              by auto
              then have "frac (v y + t) = t"
              by (metis * add_diff_cancel_left' diff_add_cancel diff_self frac_def)
              moreover from nat_intv_frac_gt0[OF v] have "0 < frac (v x)" .
              moreover from frac_distr[OF _ b] t have "frac (v x + t) = frac (v x) + t" by auto
              ultimately show ?thesis using B(5) unfolding cval_add_def by auto
            qed
          qed
        qed
      qed
    }
    with ?t/2 > 0 have "0 < ?t/2  ( t. 0 < t  t  ?t/2  (v  t)  region X I' r')" by auto
  } note ** = this
  show "t't. (v  t')  region X I' r'  0  t'"
  proof (cases " x  X. isIntv (I x)")
    case True
    note T = this
    show ?thesis
    proof (cases "t  ?t/2")
      case True with T t ** show ?thesis by auto
    next
      case False
      then have "?t/2  t" by auto
      moreover from T ** have "(v  ?t/2)  region X I' r'" "?t/2 > 0" by auto
      ultimately show ?thesis by (fastforce del: region.cases)
    qed
  next
    case False
    note F = this
    show ?thesis
    proof (cases "t < 1")
      case True with F t * show ?thesis by auto
    next
      case False
      then have "0.5  t" by auto
      moreover from F * have "(v  0.5)  region X I' r'" by auto
      ultimately show ?thesis by (fastforce del: region.cases)
    qed
  qed
next
  fix v t assume A: "v  region X I' r'" "0  t" "(v  t)  R"
  from assms(3,4) obtain x c where x: "I x = Const c" "x  Z" "x  X" by auto
  with A(1) have "intv_elem x v (I' x)" by auto
  with x have "v x > c" unfolding I'_def
    apply (auto elim: intv_elem.cases)
    apply (cases "c = k x")
  by auto
  moreover from A(3) x(1,3) have "v x + t = c"
  by (fastforce elim!: intv_elem.cases simp: cval_add_def R_def)
  ultimately show False using A(2) by auto
next
  fix x c assume "x  X" "I' x = Const c"
  then show False
    apply (auto simp: I'_def Z_def)
    apply (cases "c. I x  Const c")
     apply auto
    apply (rename_tac c')
    apply (case_tac "c' = k x")
  by auto
next
  case (4 v t t' x c)
  note A = this
  then have "I' x = Intv c" unfolding I'_def Z_def by auto
  moreover from A have "real (c + 1)  (v  t') x + (t - t')" unfolding cval_add_def by auto
  ultimately show ?case by blast
next
  case A: (5 v t t' x c)
  show ?case
  proof (cases "x  Z")
    case False
    with A have "I x = Intv c" unfolding I'_def by auto
    with A show ?thesis unfolding cval_add_def by auto
  next
    case True
    with A(6) have "I x = Const c"
      apply (auto simp: I'_def)
      apply (cases "intv_const (I x) = k x")
    by (auto simp: Z_def)
    with A(1,5) R_def have "v x = c" by fastforce
    with A(2,7) show ?thesis by (auto simp: cval_add_def)
  qed
qed

lemma closest_valid_1:
  fixes I X k r
  defines "  {region X I r |I r. valid_region X k I r}"
  defines "R  region X I r"
  defines "Z  {x  X .  c. I x = Const c}"
  assumes "Z  {}"
  defines "I' λ x. if x  Z then I x else if intv_const (I x) = k x then Greater (k x) else Intv (intv_const (I x))"
  defines "r'  r  {(x,y) . x  Z  y  X  intv_const (I x) < k x  isIntv (I' y)}"
  assumes "finite X"
  assumes "valid_region X k I r"
  shows "valid_region X k I' r'"
proof
  let ?X0 = "{x  X. d. I x = Intv d}"
  let ?X0' = "{x  X. d. I' x = Intv d}"
  let ?S = "{(x, y). x  Z  y  X  intv_const (I x) < k x  isIntv (I' y)}"
  show "?X0' = ?X0'" ..
  from assms(8) have refl: "refl_on ?X0 r" and total: "total_on ?X0 r" and trans: "trans r"
    and valid: " x. x  X  valid_intv (k x) (I x)"
  by auto
  then have "r  ?X0 × ?X0" unfolding refl_on_def by auto
  then have "r  ?X0' × ?X0'" unfolding I'_def Z_def by auto
  moreover have "?S  ?X0' × ?X0'"
    apply (auto)
    apply (auto simp: Z_def)[]
    apply (auto simp: I'_def)[]
  done
  ultimately have "r' ?X0' × ?X0'" unfolding r'_def by auto
  then show "refl_on ?X0' r'" unfolding refl_on_def
  proof auto
    fix x d assume A: "x  X" "I' x = Intv d"
    show "(x, x)  r'"
    proof (cases "x  Z")
      case True
      with A have "intv_const (I x)  k x" unfolding I'_def by auto
      with assms(8) A(1) have "intv_const (I x) < k x" by (fastforce elim!: valid_intv.cases)
      with True A show "(x,x)  r'" by (auto simp: r'_def)
    next
      case False
      with A refl show "(x,x)  r'" by (auto simp: I'_def refl_on_def r'_def)
    qed
  qed
  show "total_on ?X0' r'" unfolding total_on_def
  proof (standard, standard, standard)
    fix x y assume "x  ?X0'" "y  ?X0'" "x  y"
    then obtain d d' where A: "xX""yX""I' x = (Intv d)" "I' y = (Intv d')" "x  y" by auto
    let ?thesis = "(x, y)  r'  (y, x)  r'"
    show ?thesis
    proof (cases "x  Z")
      case True
      with A have "intv_const (I x)  k x" unfolding I'_def by auto
      with assms(8) A(1) have "intv_const (I x) < k x" by (fastforce elim!: valid_intv.cases)
      with True A show ?thesis by (auto simp: r'_def)
    next
      case F: False
      show ?thesis
      proof (cases "y  Z")
        case True
        with A have "intv_const (I y)  k y" unfolding I'_def by auto
        with assms(8) A(2) have "intv_const (I y) < k y" by (fastforce elim!: valid_intv.cases)
        with True A show ?thesis by (auto simp: r'_def)
      next
        case False
        with A F have "I x = Intv d" "I y = Intv d'" by (auto simp: I'_def)
        with A(1,2,5) total show ?thesis unfolding total_on_def r'_def by auto
      qed
    qed
  qed
  show "trans r'" unfolding trans_def
  proof safe
    fix x y z assume A: "(x, y)  r'" "(y, z)  r'"
    show "(x, z)  r'"
    proof (cases "(x,y)  r")
      case True
      then have "y  Z" using refl unfolding Z_def refl_on_def by auto
      then have "(y, z)  r" using A unfolding r'_def by auto
      with trans True show ?thesis unfolding trans_def r'_def by blast
    next
      case False
      with A(1) have F: "x  Z" "intv_const (I x) < k x" unfolding r'_def by auto
      moreover from A(2) refl have "z  X" "isIntv (I' z)"
      by (auto simp: r'_def refl_on_def) (auto simp: I'_def Z_def)
      ultimately show ?thesis unfolding r'_def by auto
    qed
  qed
  show "xX. valid_intv (k x) (I' x)"
  proof (auto simp: I'_def intro: valid, goal_cases)
    case (1 x)
    with assms(8) have "intv_const (I x) < k x" by (fastforce elim!: valid_intv.cases)
    then show ?case by auto
  qed
qed

lemma closest_prestable_2:
  fixes I X k r
  defines "  {region X I r |I r. valid_region X k I r}"
  defines "R  region X I r"
  assumes " x  X. ¬ isConst (I x)"
  defines "X0  {x  X. isIntv (I x)}"
  defines "M  {x  X0.  y  X0. (x, y)  r  (y, x)  r}"
  defines "I' λ x. if x  M then I x else Const (intv_const (I x) + 1)"
  defines "r'  {(x,y)  r. x  M  y  M}"
  assumes "finite X"
  assumes "valid_region X k I r"
  assumes "M  {}"
  shows   " v  R.  t0. (v  t)  R  (t't. (v  t')  region X I' r'  t'  0)"
  and     " v  region X I' r'.  t0. (v  t)  R"
  and     " v  R.  t'. {x. x  X  ( c. I' x = Intv c  (v  t') x + (t - t')  real (c + 1))}
                  = {x. x  X  ( c. I x  = Intv c  v x + t  real (c + 1))} - M"
  and     " x  X. isConst (I' x)"
proof (safe, goal_cases)
  fix v assume v: "v  R" fix t :: t assume t: "t  0" "(v  t)  R"
  note M = assms(10)
  then obtain x c where x: "x  M" "I x = Intv c" "x  X" "x  X0" unfolding M_def X0_def by force
  let ?t = "1 - frac (v x)"
  let ?v = "v  ?t"
  have elem: "intv_elem x v (I x)" if "x  X" for x using that v unfolding R_def by auto
  from assms(9) have *: "trans r" "total_on {x  X. d. I x = Intv d} r" by auto
  then have trans[intro]: "x y z. (x, y)  r  (y, z)  r  (x, z)  r" unfolding trans_def
  by blast
  have "{x  X. d. I x = Intv d} = X0" unfolding X0_def by auto
  with *(2) have total: "total_on X0 r" by auto
  { fix y assume y: "y  M" "y  X0"
    have "¬ (x, y)  r" using x y unfolding M_def by auto
    moreover with total x y have "(y, x)  r" unfolding total_on_def by auto
    ultimately have "¬ (x, y)  r  (y, x)  r" ..
  } note M_max = this
  { fix y assume T1: "y  M" "x  y"
    then have T2: "y  X0" unfolding M_def by auto
    with total x T1 have "(x, y)  r  (y, x)  r" by (auto simp: total_on_def)
    with T1(1) x(1) have "(x, y)  r" "(y, x)  r" unfolding M_def by auto
  } note M_eq = this
  { fix y assume y: "y  M" "y  X0"
    with M_max have "¬ (x, y)  r" "(y, x)  r" by auto
    with v[unfolded R_def] X0_def x(4) y(2) have "frac (v y) < frac (v x)" by auto
    then have "?t < 1 - frac (v y)" by auto
  } note t_bound' = this
  { fix y assume y: "y  X0"
    have "?t  1 - frac (v y)"
    proof (cases "x = y")
      case True thus ?thesis by simp
    next
      case False
      have "(y, x)  r"
      proof (cases "y  M")
        case False with M_max y show ?thesis by auto
      next
        case True with False M_eq y show ?thesis by auto
      qed
      with v[unfolded R_def] X0_def x(4) y have "frac (v y)  frac (v x)" by auto
      then show "?t  1 - frac (v y)" by auto
    qed
  } note t_bound''' = this
  have "frac (v x) < 1" by (simp add: frac_lt_1)
  then have "?t > 0" by (simp add: x(3))
  { fix c y fix t :: t assume y: "y  M" "I y = Intv c" "y  X" and t: "t  0" "t  ?t"
    then have "y  X0" unfolding X0_def by auto
    with t_bound' y have "?t < 1 - frac (v y)" by auto
    with t have "t < 1 - frac (v y)" by auto
    moreover from elem[OF y  X] y have "c < v y" "v y < c + 1" by auto
    ultimately have "(v y + t) < c + 1" using frac_add_le_preservation by blast
    with c < v y t have "intv_elem y (v  t) (I y)" by (auto simp: cval_add_def y)
  } note t_bound = this
  from elem[OF x(3)] x(2) have v_x: "c < v x" "v x < c + 1" by auto
  then have "floor (v x) = c" by linarith
  then have shift: "v x + ?t = c + 1" unfolding frac_def by auto
  have "v x + t  c + 1"
  proof (rule ccontr, goal_cases)
    case 1
    then have AA: "v x + t < c + 1" by simp
    with shift have lt: "t < ?t" by auto
    let ?v = "v  t"
    have "?v  region X I r"
    proof (standard, goal_cases)
      case 1
      from v have " x  X. v x  0" unfolding R_def by auto
      with t show ?case unfolding cval_add_def by auto
    next
      case 2
      show ?case
      proof (safe, goal_cases)
        case (1 y)
        note A = this
        with elem have e: "intv_elem y v (I y)" by auto
        show ?case
        proof (cases "y  M")
          case False
          then have [simp]: "I' y = I y" by (auto simp: I'_def)
          show ?thesis
          proof (cases "I y", goal_cases)
            case 1 with assms(3) A show ?case by auto
          next
            case (2 c)
            from t_bound[OF False this A t(1)] lt show ?case by (auto simp: cval_add_def 2)
          next
            case (3 c)
            with e have "v y > c" by auto
            with 3 t(1) show ?case by (auto simp: cval_add_def)
          qed
        next
          case True
          then have "y  X0" by (auto simp: M_def)
          note T = this True
          show ?thesis
          proof (cases "x = y")
            case False
            with M_eq T have "(x, y)  r" "(y, x)  r" by presburger+
            with v[unfolded R_def] X0_def x(4) T(1) have *: "frac (v y) = frac (v x)" by auto
            from T(1) obtain c where c: "I y = Intv c" by (auto simp: X0_def)
            with elem T(1) have "c < v y" "v y < c + 1" by (fastforce simp: X0_def)+
            then have "floor (v y) = c" by linarith
            with * lt have "(v y + t) < c + 1" unfolding frac_def by auto
            with c < v y t show ?thesis by (auto simp: c cval_add_def)
          next
            case True with c < v x t AA x show ?thesis by (auto simp: cval_add_def)
          qed
        qed
      qed
    next
      show "X0 = {x  X. d. I x = Intv d}" by (auto simp add: X0_def)
    next
      have "t > 0"
      proof (rule ccontr, goal_cases)
        case 1 with t v show False unfolding cval_add_def by auto
      qed 
      show "yX0. zX0. ((y, z)  r) = (frac ((v  t)y)  frac ((v  t) z))"
      proof (auto simp: X0_def, goal_cases)
        case (1 y z d d')
        note A = this
        from A have [simp]: "y  X0" "z  X0" unfolding X0_def I'_def by auto
        from A v[unfolded R_def] have le: "frac (v y)  frac (v z)" by (auto simp: r'_def)
        from t_bound''' have "?t  1 - frac (v y)" "?t  1 - frac (v z)" by auto
        with lt have "t < 1 - frac (v y)" "t < 1 - frac (v z)" by auto
        with frac_distr[OF t > 0] have
          "frac (v y) + t = frac (v y + t)" "frac (v z) + t = frac (v z + t)"
        by auto
        with le show ?case by (auto simp: cval_add_def)
      next
        case (2 y z d d')
        note A = this
        from A have [simp]: "y  X0" "z  X0" unfolding X0_def by auto
        from t_bound''' have "?t  1 - frac (v y)" "?t  1 - frac (v z)" by auto
        with lt have "t < 1 - frac (v y)" "t < 1 - frac (v z)" by auto
        from frac_add_leD[OF t > 0 this] A(5) have
          "frac (v y)  frac (v z)"
        by (auto simp: cval_add_def)
        with v[unfolded R_def] A show ?case by auto
      qed
    qed
    with t R_def show False by simp
  qed
  with shift have "t  ?t" by simp
  let ?R = "region X I' r'"
  let ?X0 = "{x  X. d. I' x = Intv d}"
  have "(v  ?t)  ?R"
  proof (standard, goal_cases)
    case 1
    from v have " x  X. v x  0" unfolding R_def by auto
    with ?t > 0 t show ?case unfolding cval_add_def by auto
  next
    case 2
    show ?case
    proof (safe, goal_cases)
      case (1 y)
      note A = this
      with elem have e: "intv_elem y v (I y)" by auto
      show ?case
      proof (cases "y  M")
        case False
        then have [simp]: "I' y = I y" by (auto simp: I'_def)
        show ?thesis
        proof (cases "I y", goal_cases)
          case 1 with assms(3) A show ?case by auto
        next
          case (2 c)
          from t_bound[OF False this A] ?t > 0 show ?case by (auto simp: cval_add_def 2)
        next
          case (3 c)
          with e have "v y > c" by auto
          with 3 ?t > 0 show ?case by (auto simp: cval_add_def)
        qed
      next
        case True
        then have "y  X0" by (auto simp: M_def)
        note T = this True
        show ?thesis
        proof (cases "x = y")
          case False
          with M_eq T(2) have "(x, y)  r" "(y, x)  r" by auto
          with v[unfolded R_def] X0_def x(4) T(1) have *: "frac (v y) = frac (v x)" by auto
          from T(1) obtain c where c: "I y = Intv c" by (auto simp: X0_def)
          with elem T(1) have "c < v y" "v y < c + 1" by (fastforce simp: X0_def)+
          then have "floor (v y) = c" by linarith
          with * have "(v y + ?t) = c + 1" unfolding frac_def by auto
          with T(2) show ?thesis by (auto simp: c cval_add_def I'_def)
        next
          case True with shift x show ?thesis by (auto simp: cval_add_def I'_def)
        qed
      qed
    qed
  next
    show "?X0 = ?X0" ..
  next
    show "y?X0. z?X0. ((y, z)  r') = (frac ((v  1 - frac (v x))y)  frac ((v  1 - frac (v x)) z))"
    proof (safe, goal_cases)
      case (1 y z d d')
      note A = this
      then have "y  M" "z  M" unfolding I'_def by auto
      with A have [simp]: "I' y = I y" "I' z = I z" "y  X0" "z  X0" unfolding X0_def I'_def by auto
      from A v[unfolded R_def] have le: "frac (v y)  frac (v z)" by (auto simp: r'_def)
      from t_bound' y  M z  M have "?t < 1 - frac (v y)" "?t < 1 - frac (v z)" by auto
      with frac_distr[OF ?t > 0] have
        "frac (v y) + ?t = frac (v y + ?t)" "frac (v z) + ?t = frac (v z + ?t)"
      by auto
      with le show ?case by (auto simp: cval_add_def)
    next
      case (2 y z d d')
      note A = this
      then have M: "y  M" "z  M" unfolding I'_def by auto
      with A have [simp]: "I' y = I y" "I' z = I z" "y  X0" "z  X0" unfolding X0_def I'_def by auto
      from t_bound' y  M z  M have "?t < 1 - frac (v y)" "?t < 1 - frac (v z)" by auto
      from frac_add_leD[OF ?t > 0 this] A(5) have
        "frac (v y)  frac (v z)"
      by (auto simp: cval_add_def)
      with v[unfolded R_def] A M show ?case by (auto simp: r'_def)
    qed
  qed
  with ?t > 0 ?t  t show "t't. (v  t')  region X I' r'  0  t'" by auto
next
  fix v t assume A: "v  region X I' r'" "0  t" "(v  t)  R"
  from assms(10) obtain x c where x:
    "x  X0" "I x = Intv c" "x  X" "x  M"
  unfolding M_def X0_def by force
  with A(1) have "intv_elem x v (I' x)" by auto
  with x have "v x = c + 1" unfolding I'_def by auto
  moreover from A(3) x(2,3) have "v x + t < c + 1" by (fastforce simp: cval_add_def R_def)
  ultimately show False using A(2) by auto
next
  case A: (3 v t' x c)
  from A(3) have "I x = Intv c" by (auto simp: I'_def) (cases "x  M", auto)
  with A(4) show ?case by (auto simp: cval_add_def)
next
  case 4
  then show ?case unfolding I'_def by auto
next
  case A: (5 v t' x c)
  then have "I' x = Intv c" unfolding I'_def by auto
  moreover from A have "real (c + 1)  (v  t') x + (t - t')" by (auto simp: cval_add_def)
  ultimately show ?case by blast
next
  from assms(5,10) obtain x where x: "x  M" by blast
  then have "isConst (I' x)" by (auto simp: I'_def)
  with x show "xX. isConst (I' x)" unfolding M_def X0_def by force
qed

lemma closest_valid_2:
  fixes I X k r
  defines "  {region X I r |I r. valid_region X k I r}"
  defines "R  region X I r"
  assumes " x  X. ¬ isConst (I x)"
  defines "X0  {x  X. isIntv (I x)}"
  defines "M  {x  X0.  y  X0. (x, y)  r  (y, x)  r}"
  defines "I' λ x. if x  M then I x else Const (intv_const (I x) + 1)"
  defines "r'  {(x,y)  r. x  M  y  M}"
  assumes "finite X"
  assumes "valid_region X k I r"
  assumes "M  {}"
  shows "valid_region X k I' r'"
proof
  let ?X0 = "{x  X. d. I x = Intv d}"
  let ?X0' = "{x  X. d. I' x = Intv d}"
  show "?X0' = ?X0'" ..
  from assms(9) have refl: "refl_on ?X0 r" and total: "total_on ?X0 r" and trans: "trans r"
    and valid: " x. x  X  valid_intv (k x) (I x)"
  by auto
  have subs: "r'  r" unfolding r'_def by auto
  from refl have "r  ?X0 × ?X0" unfolding refl_on_def by auto
  then have "r' ?X0' × ?X0'" unfolding r'_def I'_def by auto
  then show "refl_on ?X0' r'" unfolding refl_on_def
  proof auto
    fix x d assume A: "x  X" "I' x = Intv d"
    then have "x  M" by (force simp: I'_def)
    with A have "I x = Intv d" by (force simp: I'_def)
    with A refl have "(x,x)  r" by (auto simp: refl_on_def)
    then show "(x, x)  r'" by (auto simp: r'_def x  M)
  qed
  show "total_on ?X0' r'" unfolding total_on_def
  proof (safe, goal_cases)
    case (1 x y d d')
    note A = this
    then have *: "x  M" "y  M" by (force simp: I'_def)+
    with A have "I x = Intv d" "I y = Intv d'" by (force simp: I'_def)+
    with A total have "(x, y)  r  (y, x)  r" by (auto simp: total_on_def)
    with A(6) * show ?case unfolding r'_def by auto
  qed
  show "trans r'" unfolding trans_def
  proof safe
    fix x y z assume A: "(x, y)  r'" "(y, z)  r'"
    from trans have [intro]:
      " x y z. (x,y)  r  (y, z)  r  (x, z)  r"
    unfolding trans_def by blast
    from A show "(x, z)  r'" by (auto simp: r'_def)
  qed
  show "xX. valid_intv (k x) (I' x)"
  using valid  unfolding I'_def
  proof (auto simp: I'_def intro: valid, goal_cases)
    case (1 x)
    with assms(9) have "intv_const (I x) < k x" by (fastforce simp: M_def X0_def)
    then show ?case by auto
  qed
qed

subsection ‹Putting the Proof for the 'Set of Regions' Property Together›

subsubsection ‹Misc›

lemma total_finite_trans_max:
  "X  {}  finite X  total_on X r  trans r   x  X.  y  X. x  y  (y, x)  r"
proof (induction "card X" arbitrary: X)
  case 0
  then show ?case by auto
next
  case (Suc n)
  then obtain x where x: "x  X" by blast
  show ?case
  proof (cases "n = 0")
    case True
    with Suc.hyps(2) ‹finite X x have "X = {x}" by (metis card_Suc_eq empty_iff insertE)
    then show ?thesis by auto
  next
    case False
    show ?thesis
    proof (cases "yX. x  y  (y, x)  r")
      case True with x show ?thesis by auto
    next
      case False
      then obtain y where y: "y  X" "x  y" "¬ (y, x)  r" by auto
      with x Suc.prems(3) have "(x, y)  r" unfolding total_on_def by blast
      let ?X = "X - {x}"
      have tot: "total_on ?X r" using ‹total_on X r unfolding total_on_def by auto
      from x Suc.hyps(2) ‹finite X have card: "n = card ?X" by auto
      with ‹finite X n  0 have "?X  {}" by auto
      from Suc.hyps(1)[OF card this _ tot ‹trans r] ‹finite X obtain x' where
        IH: "x'  ?X" " y  ?X. x'  y  (y, x')  r"
      by auto
      have "(x', x)  r"
      proof (rule ccontr, auto)
        assume A: "(x', x)  r"
        with y(3) have "x'  y" by auto
        with y IH have "(y, x')  r" by auto
        with ‹trans r A have "(y, x)  r" unfolding trans_def by blast
        with y show False by auto
      qed
      with x  X x'  ?X ‹total_on X r have "(x, x')  r" unfolding total_on_def by auto
      with IH show ?thesis by auto
    qed
  qed
qed

lemma card_mono_strict_subset:
  "finite A  finite B  finite C  A  B  {}  C = A - B  card C < card A"
by (metis Diff_disjoint Diff_subset inf_commute less_le psubset_card_mono)

subsubsection ‹Proof›

text ‹
  First we show that a shift by a non-negative integer constant means that any two valuations from 
  the same region are being shifted to the same region.
›

lemma int_shift_equiv:
  fixes X k fixes t :: int
  defines "  {region X I r |I r. valid_region X k I r}"
  assumes "v  R" "v'  R" "R  " "t  0"
  shows "(v'  t)  [v  t]⇩" using assms
proof -
  from assms obtain I r where A: "R = region X I r" "valid_region X k I r" by auto
  from regions_closed[OF _ assms(4,2), of X k t] assms(1,5) obtain I' r' where RR:
    "[v  t]⇩ = region X I' r'" "valid_region X k I' r'"
  by auto
  from regions_closed'[OF _ assms(4,2), of X k t] assms(1,5) have RR': "(v  t)  [v  t]⇩" by auto
  show ?thesis
  proof (simp add: RR(1), rule, goal_cases)
    case 1
    from v'  R A(1) have "xX. 0  v' x" by auto
    with t  0 show ?case unfolding cval_add_def by auto
  next
    case 2
    show ?case
    proof safe
      fix x assume x: "x  X"
      with v'  R v  R A(1) have I: "intv_elem x v (I x)" "intv_elem x v' (I x)" by auto
      from x RR RR' have I': "intv_elem x (v  t) (I' x)" by auto
      show "intv_elem x (v'  t) (I' x)"
      proof (cases "I' x")
        case (Const c)
        from Const I' have "v x + t = c" unfolding cval_add_def by auto
        with x A(1) v  R t  0 have *: "v x = c - nat t" "t  c" by fastforce+
        with t  0 I(1) have "I x = Const (c - nat t)"
        proof (cases "I x", auto)
          case (Greater c')
          from RR(2) Const x  X have "c  k x" by fastforce
          with Greater * t  0 have *: "v x  k x" by auto
          from Greater A(2) x  X have "c' = k x" by fastforce
          moreover from I(1) Greater have "v x > c'" by auto
          ultimately show False using c  k x * by auto
        qed
        with I t  0 *(2) have "v' x + t = c" by auto
        with Const show ?thesis unfolding cval_add_def by auto
      next
        case (Intv c)
        with I' have "c < v x + t" "v x + t < c + 1" unfolding cval_add_def by auto
        with x A(1) v  R t  0 have
          *: "c - nat t < v x" "v x < c - nat t + 1" "t  c"
        by fastforce+
        with I have "I x = Intv (c - nat t)"
        proof (cases "I x", auto)
          case (Greater c')
          from RR(2) Intv x  X have "c < k x" by fastforce
          with Greater * have *: "v x  k x" by auto
          from Greater A(2) x  X have "c' = k x" by fastforce
          moreover from I(1) Greater have "v x > c'" by auto
          ultimately show False using c < k x * by auto
        qed
        with I t  c have "c < v' x + nat t" "v' x + t < c + 1" by auto
        with Intv t  0 show ?thesis unfolding cval_add_def by auto
      next
        case (Greater c)
        with I' have *: "c < v x + t" unfolding cval_add_def by auto
        show ?thesis
        proof (cases "I x")
          case (Const c')
          with x A(1) I(2) v  R v'  R have "v x = v' x" by fastforce
          with Greater * show ?thesis unfolding cval_add_def by auto
        next
          case (Intv c')
          with x A(1) I(2) v  R v'  R have **: "c' < v x" "v x < c' + 1" "c' < v' x"
          by fastforce+
          then have "c' + t < v x + t" "v x + t < c' + t + 1" by auto
          with * have "c  c' + t" by auto
          with **(3) have "v' x + t > c" by auto
          with Greater * show ?thesis unfolding cval_add_def by auto
        next
          fix c' assume c': "I x = Greater c'"
          with x A(1) I(2) v  R v'  R have **: "c' < v x" "c' < v' x" by fastforce+
          from Greater RR(2) c' A(2) x  X have "c' = k x" "c = k x" by fastforce+
          with t  0 **(2) Greater show "intv_elem x (v'  real_of_int t) (I' x)"
          unfolding cval_add_def by auto
        qed
      qed
    qed
  next
    show "{x  X. d. I' x = Intv d} = {x  X. d. I' x = Intv d}" ..
  next
    let ?X0 = "{x  X. d. I' x = Intv d}"
    { fix x y :: real
      have "frac (x + t)  frac (y + t)  frac x  frac y" by (simp add: frac_def)
    } note frac_equiv = this
    { fix x y
      have "frac ((v  t) x)  frac ((v  t) y)  frac (v x)  frac (v y)"
      unfolding cval_add_def using frac_equiv by auto
    } note frac_equiv' = this
    { fix x y
      have "frac ((v'  t) x)  frac ((v'  t) y)  frac (v' x)  frac (v' y)"
      unfolding cval_add_def using frac_equiv by auto
    } note frac_equiv'' = this
    { fix x y assume x: "x  X" and y: "y  X" and B: "¬ isGreater(I x)" "¬ isGreater(I y)"
      have "frac (v x)  frac (v y)  frac (v' x)  frac (v' y)"
      proof (cases "I x")
        case (Const c)
        with x v  R v'  R A(1) have "v x = c" "v' x = c" by fastforce+
        then have "frac (v x)  frac (v y)" "frac (v' x)  frac (v' y)" by(simp add: frac_def)+
        then show ?thesis by auto
      next
        case (Intv c)
        with x v  R A(1) have v: "c < v x" "v x < c + 1" by fastforce+
        from Intv x v'  R A(1) have v':"c < v' x" "v' x < c + 1" by fastforce+
        show ?thesis
        proof (cases "I y", goal_cases)
          case (Const c')
          with y v  R v'  R A(1) have "v y = c'" "v' y = c'" by fastforce+
          then have "frac (v y) = 0" "frac (v' y) = 0" by auto
          with nat_intv_frac_gt0[OF v] nat_intv_frac_gt0[OF v']
          have "¬ frac (v x)  frac (v y)" "¬ frac (v' x)  frac (v' y)" by linarith+
          then show ?thesis by auto
        next
          case 2: (Intv c')
          with x y Intv v  R v'  R A(1) have
            "(x, y)  r  frac (v x)  frac (v y)"
            "(x, y)  r  frac (v' x)  frac (v' y)"
          by auto
          then show ?thesis by auto
        next
          case Greater
          with B show ?thesis by auto
        qed
      next
        case Greater with B show ?thesis by auto
      qed
    } note frac_cong = this
    have not_greater: "¬ isGreater (I x)" if x: "x  X" "¬ isGreater (I' x)" for x
    proof (rule ccontr, auto, goal_cases)
      case (1 c)
      with x v  R A(1,2) have "c < v x" by fastforce+
      moreover from x A(2) 1 have "c = k x" by fastforce+
      ultimately have *: "k x < v x + t" using t  0 by simp
      from RR(1,2) RR' x have I': "intv_elem x (v  t) (I' x)" "valid_intv (k x) (I' x)" by auto
      from x show False
      proof (cases "I' x", auto)
        case (Const c')
        with I' * show False by (auto simp: cval_add_def)
      next
        case (Intv c')
        with I' * show False by (auto simp: cval_add_def)
      qed
    qed
    show " x  ?X0. y  ?X0. ((x, y)  r') = (frac ((v'  t) x)  frac ((v'  t) y))"
    proof (standard, standard)
      fix x y assume x: "x  ?X0" and y: "y  ?X0"
      then have B: "¬ isGreater (I' x)" "¬ isGreater (I' y)" by auto
      with x y not_greater have "¬ isGreater (I x)" "¬ isGreater (I y)" by auto
      with x y frac_cong have "frac (v x)  frac (v y)  frac (v' x)  frac (v' y)" by auto
      moreover from x y RR(1) RR' have "(x, y)  r'  frac ((v  t) x)  frac ((v  t) y)"
      by fastforce
      ultimately show "(x, y)  r'  frac ((v'  t) x)  frac ((v'  t) y)"
      using frac_equiv' frac_equiv'' by blast
    qed
  qed
qed

text ‹
  Now, we can use the 'immediate' induction proposed by P. Bouyer for shifts smaller than one.
  The induction principle is not at all obvious: the induction is over the set of clocks for
  which the valuation is shifted beyond the current interval boundaries.
  Using the two successor operations, we can see that either the set of these clocks remains the
  same (Z ~= {}) or strictly decreases (Z = {}).
›

lemma set_of_regions_lt_1:
  fixes X k I r t v
  defines "  {region X I r |I r. valid_region X k I r}"
  defines "C  {x. x  X  ( c. I x = Intv c  v x + t  c + 1)}"
  assumes "valid_region X k I r" "v  region X I r" "v'  region X I r" "finite X" "0  t" "t < 1"
  shows " t'0. (v'  t')  [v  t]⇩" using assms
proof (induction "card C" arbitrary: C I r v v' t rule: less_induct)
  case less
  let ?R = "region X I r"
  let ?C = "{x  X. c. I x = Intv c  real (c + 1)  v x + t}"
  from less have R: "?R  " by auto
  { fix v I k r fix t :: t
    assume no_consts: "xX. ¬isConst (I x)"
    assume v: "v  region X I r"
    assume t: "t  0"
    let ?C = "{x  X. c. I x = Intv c  real (c + 1)  v x + t}"
    assume C: "?C = {}"
    let ?R = "region X I r"
    have "(v  t)  ?R"
    proof (rule, goal_cases)
      case 1
      with t  0 v  ?R show ?case by (auto simp: cval_add_def)
    next
      case 2
      show ?case
      proof (standard, case_tac "I x", goal_cases)
        case (1 x c)
        with no_consts show ?case by auto
      next
        case (2 x c)
        with v  ?R have "c < v x" by fastforce
        with t  0 have "c < v x + t" by auto
        moreover from 2 C have "v x + t < c + 1" by fastforce
        ultimately show ?case by (auto simp: 2 cval_add_def)
      next
        case (3 x c)
        with v  ?R have "c < v x" by fastforce
        with t  0 have "c < v x + t" by auto
        then show ?case by (auto simp: 3 cval_add_def)
      qed
    next
        show "{x  X. d. I x = Intv d} = {x  X. d. I x = Intv d}" ..
    next
      let ?X0 = "{x  X. d. I x = Intv d}"
      { fix x d :: real fix c:: nat assume A: "c < x" "x + d < c + 1" "d  0"
        then have "d < 1 - frac x" unfolding frac_def using floor_eq3 of_nat_Suc by fastforce
      } note intv_frac = this
      { fix x assume x: "x  ?X0"
        then obtain c where x: "x  X" "I x = Intv c" by auto
        with v  ?R have *: "c < v x" by fastforce
        with t  0 have "c < v x + t" by auto
        from x C have "v x + t < c + 1" by auto
        from intv_frac[OF * this t  0] have "t < 1 - frac (v x) " by auto
      } note intv_frac = this
      { fix x y assume x: "x  ?X0" and y: "y  ?X0"
        from frac_add_leIFF[OF t  0 intv_frac[OF x] intv_frac[OF y]]
        have "frac (v x)  frac (v y)  frac ((v  t) x)  frac ((v  t) y)"
        by (auto simp: cval_add_def)
      } note frac_cong = this
      show " x  ?X0.  y  ?X0. (x, y)  r  frac ((v   t) x)  frac ((v  t) y)"
      proof (standard, standard, goal_cases)
        case (1 x y)
        with v  ?R have "(x, y)  r  frac (v x)  frac (v y)" by auto
        with frac_cong[OF 1] show ?case by simp
      qed
    qed
  } note critical_empty_intro = this
  { assume const: "xX. isConst (I x)"
    assume t: "t > 0"
    from const have "{x  X. c. I x = Const c}  {}" by auto
    from closest_prestable_1[OF this less.prems(4) less(3)] R closest_valid_1[OF this less.prems(4) less(3)]
    obtain I'' r''
      where   stability: " v  ?R.  t>0. t't. (v  t')  region X I'' r''  t'  0"
      and succ_not_refl: " v  region X I'' r''.  t0. (v  t)  ?R"
      and no_consts:     " x  X. ¬ isConst (I'' x)"
      and crit_mono:     " v  ?R.  t < 1.  t'  0. (v  t')  region X I'' r''
                           {x. x  X  ( c. I x = Intv c  v x + t  c + 1)}
                            = {x. x  X  ( c. I'' x = Intv c  (v  t') x + (t - t')  c + 1)}"
      and succ_valid:    "valid_region X k I'' r''"
    by auto
    let ?R'' = "region X I'' r''"
    from stability less(4) t > 0 obtain t1 where t1: "t1  0" "t1  t" "(v  t1)  ?R''" by auto
    from stability less(5) t > 0 obtain t2 where t2: "t2  0" "t2  t" "(v'  t2)  ?R''" by auto
    let ?v = "v  t1"
    let ?t = "t - t1"
    let ?C' = "{x  X. c. I'' x = Intv c  real (c + 1)  ?v x + ?t}"
    from t1 t < 1 have tt: "0  ?t" "?t < 1" by auto
    from crit_mono t < 1 t1(1,3) v  ?R have crit:
      "?C = ?C'"
    by auto
    with t1 t2 succ_valid no_consts have
      " t1  0.  t2  0.  I' r'. t1  t  (v  t1)  region X I' r'
        t2  t  (v'  t2)  region X I' r'
        valid_region X k I' r'
        ( x  X. ¬ isConst (I' x))
        ?C = {x  X. c. I' x = Intv c  real (c + 1)  (v  t1) x + (t - t1)}"
    by blast
  } note const_dest = this
  { fix t :: real fix v I r x c v'
    let ?R = "region X I r"
    assume v: "v  ?R"
    assume v': "v'  ?R"
    assume valid: "valid_region X k I r"
    assume t: "t > 0" "t < 1"
    let ?C = "{x  X. c. I x = Intv c  real (c + 1)  v x + t}"
    assume C: "?C = {}"
    assume const: " x  X. isConst (I x)"
    then have "{x  X. c. I x = Const c}  {}" by auto
    from closest_prestable_1[OF this less.prems(4) valid] R closest_valid_1[OF this less.prems(4) valid]
    obtain I'' r''
      where   stability: " v  ?R.  t>0. t't. (v  t')  region X I'' r''  t'  0"
      and succ_not_refl: " v  region X I'' r''.  t0. (v  t)  ?R"
      and no_consts:     " x  X. ¬ isConst (I'' x)"
      and crit_mono:     " v  ?R.  t < 1.  t'  0. (v  t')  region X I'' r''
                           {x. x  X  ( c. I x = Intv c  v x + t  c + 1)}
                            = {x. x  X  ( c. I'' x = Intv c  (v  t') x + (t - t')  c + 1)}"
      and succ_valid:    "valid_region X k I'' r''"
    by auto
    let ?R'' = "region X I'' r''"
    from stability v t > 0 obtain t1 where t1: "t1  0" "t1  t" "(v  t1)  ?R''" by auto
    from stability v' t > 0 obtain t2 where t2: "t2  0" "t2  t" "(v'  t2)  ?R''" by auto
    let ?v = "v  t1"
    let ?t = "t - t1"
    let ?C' = "{x  X. c. I'' x = Intv c  real (c + 1)  ?v x + ?t}"
    from t1 t < 1 have tt: "0  ?t" "?t < 1" by auto
    from crit_mono t < 1 t1(1,3) v  ?R have crit:
      "{x  X. c. I x = Intv c  real (c + 1)  v x + t}
        = {x  X. c. I'' x = Intv c  real (c + 1)  (v  t1) x + (t - t1)}"
    by auto
    with C have C: "?C' = {}" by blast
    from critical_empty_intro[OF no_consts t1(3) tt(1) this] have "((v  t1)  ?t)  ?R''" .
    from region_unique[OF less(2) this] less(2) succ_valid t2 have "t'0. (v'  t')  [v  t]⇩"
    by (auto simp: cval_add_def)
  } note intro_const = this
  { fix v I r t x c v'
    let ?R = "region X I r"
    assume v: "v  ?R"
    assume v': "v'  ?R"
    assume F2: "xX. ¬isConst (I x)"
    assume x: "x  X" "I x = Intv c" "v x + t  c + 1"
    assume valid: "valid_region X k I r"
    assume t: "t  0" "t < 1"
    let ?C' = "{x  X. c. I x = Intv c  real (c + 1)  v x + t}"
    assume C: "?C = ?C'"
    have not_in_R: "(v  t)  ?R"
    proof (rule ccontr, auto)
      assume "(v  t)  ?R"
      with x(1,2) have "v x + t < c + 1" by (fastforce simp: cval_add_def)
      with x(3) show False by simp
    qed
    have not_in_R': "(v'  1)  ?R"
    proof (rule ccontr, auto)
      assume "(v'  1)  ?R"
      with x have "v' x + 1 < c + 1" by (fastforce simp: cval_add_def)
      moreover from x v' have "c < v' x" by fastforce
      ultimately show False by simp
    qed
    let ?X0 = "{x  X. isIntv (I x)}"
    let ?M = "{x  ?X0. y?X0. (x, y)  r  (y, x)  r}"
    from x have x: "x  X" "¬ isGreater (I x)" and c: "I x = Intv c" by auto
    with x  X have *: "?X0  {}" by auto
    have "?X0 = {x  X. d. I x = Intv d}" by auto
    with valid have r: "total_on ?X0 r" "trans r" by auto
    from total_finite_trans_max[OF * _ this] ‹finite X
    obtain x' where x': "x'  ?X0" " y  ?X0. x'  y  (y, x')  r" by fastforce
    from this(2) have "y?X0. (x', y)  r  (y, x')  r" by auto
    with x'(1) have "?M  {}" by fastforce
    from closest_prestable_2[OF F2 less.prems(4) valid this] closest_valid_2[OF F2 less.prems(4) valid this] 
    obtain I' r'
      where   stability:
        " v  region X I r.  t0. (v  t)  region X I r  (t't. (v  t')  region X I' r'  t'  0)"
      and succ_not_refl: " v  region X I' r'.  t0. (v  t)  region X I r"
      and critical_mono: " v  region X I r. t.  t'.
                            {x. x  X  ( c. I' x = Intv c  (v  t') x + (t - t')  real (c + 1))}
                            = {x. x  X  ( c. I x  = Intv c  v x + t  real (c + 1))} - ?M"
      and const_ex:      "xX. isConst (I' x)"
      and succ_valid:    "valid_region X k I' r'"
    by auto
    let ?R' = "region X I' r'"
    from not_in_R stability t  0 v obtain t' where
      t': "t'  0" "t'  t" "(v  t')  ?R'"
    by blast
    have "(1::t)  0" by auto
    with not_in_R' stability v' obtain t1 where
      t1: "t1  0" "t1  1" "(v'  t1)  ?R'"
    by blast
    let ?v = "v  t'"
    let ?t = "t - t'"
    let ?C'' = "{x  X. c. I' x = Intv c  real (c + 1)  ?v x + ?t}"
    have "t'0. (v'  t')  [v  t]⇩"
    proof (cases "t = t'")
      case True
      with t' have "(v  t)  ?R'" by auto
      from region_unique[OF less(2) this] succ_valid ℛ_def have "[v  t]⇩ = ?R'" by blast
      with t1(1,3) show ?thesis by auto
    next
      case False
      with t < 1 t' have tt: "0  ?t" "?t < 1" "?t > 0" by auto
      from critical_mono v  ?R have C_eq: "?C'' = ?C' - ?M" by auto
      show "t'0. (v'  t')  [v  t]⇩"
      proof (cases "?C'  ?M = {}")
        case False
        from ‹finite X have "finite ?C''" "finite ?C'" "finite ?M" by auto
        then have "card ?C'' < card ?C" using C_eq C False by (intro card_mono_strict_subset) auto
        from less(1)[OF this less(2) succ_valid t'(3) t1(3) ‹finite X tt(1,2)]
        obtain t2 where "t2  0" "((v'  t1)  t2)  [(v  t)]⇩" by (auto simp: cval_add_def)
        moreover have "(v'  (t1 + t2)) = ((v'  t1)  t2)" by (auto simp: cval_add_def)
        moreover have "t1 + t2  0" using t2  0 t1(1) by auto
        ultimately show ?thesis by metis
      next
        case True
        { fix x c assume x: "x  X" "I x = Intv c" "real (c + 1)  v x + t"
          with True have "x  ?M" by force
          from x have "x  ?X0" by auto
          from x(1,2) v  ?R have *: "c < v x" "v x < c + 1" by fastforce+
          with t < 1 have "v x + t < c + 2" by auto
          have ge_1: "frac (v x) + t  1"
          proof (rule ccontr, goal_cases)
            case 1
            then have A: "frac (v x) + t < 1" by auto
            from * have "floor (v x) + frac (v x) < c + 1" unfolding frac_def by auto
            with nat_intv_frac_gt0[OF *] have "floor (v x)  c" by linarith
            with A have "v x + t < c + 1" by (auto simp: frac_def)
            with x(3) show False by auto
          qed
          from ?M  {} obtain y where "y  ?M" by force
          with x  ?X0 have y: "y  ?X0" "(y, x)  r  (x, y)  r" by auto
          from y obtain c' where c': "y  X" "I y = Intv c'" by auto
          with v  ?R have "c' < v y" by fastforce
          from y  ?M x  ?M have "x  y" by auto
          with y r(1) x(1,2) have "(x, y)  r" unfolding total_on_def by fastforce
          with v  ?R c' x have "frac (v x)  frac (v y)" by fastforce
          with ge_1 have frac: "frac (v y) + t  1" by auto
          have "real (c' + 1)  v y + t"
          proof (rule ccontr, goal_cases)
            case 1
            from c' < v y have "floor (v y)  c'" by linarith
            with frac have "v y + t  c' + 1" unfolding frac_def by linarith
            with 1 show False by simp
          qed
          with c' True y  ?M have False by auto
        }
        then have C: "?C' = {}" by auto
        with C_eq have C'': "?C'' = {}" by auto
        from intro_const[OF t'(3) t1(3) succ_valid tt(3) tt(2) C'' const_ex]
        obtain t2 where "t2  0" "((v'  t1)  t2)  [v  t]⇩" by (auto simp: cval_add_def)
        moreover have "(v'  (t1 + t2)) = ((v'  t1)  t2)" by (auto simp: cval_add_def)
        moreover have "t1 + t2  0" using t2  0 t1(1) by auto
        ultimately show ?thesis by metis
      qed
    qed
  } note intro_intv = this
  from regions_closed[OF less(2) R less(4,7)] less(2) obtain I' r' where R':
      "[v  t]⇩ = region X I' r'" "valid_region X k I' r'"
  by auto
  with regions_closed'[OF less(2) R less(4,7)] assms(1) have
    R'2: "(v  t)  [v  t]⇩" "(v  t)  region X I' r'"
  by auto
  let ?R' = "region X I' r'"
  from less(2) R' have "?R'  " by auto
  show ?case
  proof (cases "?R' = ?R")
    case True with less(3,5) R'(1) have "(v'  0)  [v  t]⇩" by (auto simp: cval_add_def)
    then show ?thesis by auto
  next
    case False
    have "t > 0"
    proof (rule ccontr)
      assume "¬ 0 < t"
      with R' t  0 have "[v]⇩ = ?R'" by (simp add: cval_add_def)
      with region_unique[OF less(2) less(4) R] ?R'  ?R show False by auto
    qed
    show ?thesis
    proof (cases "?C = {}")
      case True
      show ?thesis
      proof (cases " x  X. isConst (I x)")
        case False
        then have no_consts: "xX. ¬isConst (I x)" by auto
        from critical_empty_intro[OF this v  ?R t  0 True] have "(v  t)  ?R" .
        from region_unique[OF less(2) this R] less(5) have "(v'  0)  [v  t]⇩"
        by (auto simp: cval_add_def)
        then show ?thesis by blast
      next
        case True
        from const_dest[OF this t > 0] obtain t1 t2 I' r'
          where t1:  "t1  0" "t1  t" "(v  t1)  region X I' r'"
          and   t2:  "t2  0" "t2  t" "(v'  t2)  region X I' r'"
          and valid: "valid_region X k I' r'"
          and no_consts: " x  X. ¬ isConst (I' x)"
          and   C:   "?C = {x  X. c. I' x = Intv c  real (c + 1)  (v  t1) x + (t - t1)}"
        by auto
        let ?v = "v  t1"
        let ?t = "t - t1"
        let ?C' = "{x  X. c. I' x = Intv c  real (c + 1)  ?v x + ?t}"
        let ?R' = "region X I' r'"
        from C ?C = {} have "?C' = {}" by blast
        from critical_empty_intro[OF no_consts t1(3) _ this] t1 have "(?v  ?t)  ?R'" by auto
        from region_unique[OF less(2) this] less(2) valid t2 show ?thesis
        by (auto simp: cval_add_def)
      qed
    next
      case False
      then obtain x c where x: "x  X" "I x = Intv c" "v x + t  c + 1" by auto
      then have F: "¬ ( x  X.  c. I x = Greater c)" by force
      show ?thesis
      proof (cases " x  X. isConst (I x)")
        case False
        then have "xX. ¬isConst (I x)" by auto
        from intro_intv[OF v  ?R v'  ?R this x less(3,7,8)] show ?thesis by auto
      next
        case True
        then have "{x  X. c. I x = Const c}  {}" by auto
        from const_dest[OF True t > 0] obtain t1 t2 I' r'
          where t1:  "t1  0" "t1  t" "(v  t1)  region X I' r'"
          and   t2:  "t2  0" "t2  t" "(v'  t2)  region X I' r'"
          and valid: "valid_region X k I' r'"
          and no_consts: " x  X. ¬ isConst (I' x)"
          and   C:   "?C = {x  X. c. I' x = Intv c  real (c + 1)  (v  t1) x + (t - t1)}"
        by auto
        let ?v = "v  t1"
        let ?t = "t - t1"
        let ?C' = "{x  X. c. I' x = Intv c  real (c + 1)  ?v x + ?t}"
        let ?R' = "region X I' r'"
        show ?thesis
        proof (cases "?C' = {}")
          case False
          with intro_intv[OF t1(3) t2(3) no_consts _ _ _ valid _ _ C] t < 1 t1 obtain t' where
            "t'  0" "((v'  t2)  t')  [(v  t)]⇩"
          by (auto simp: cval_add_def)
          moreover have "((v'  t2)  t') = (v'  (t2 + t'))" by (auto simp: cval_add_def)
          moreover have "t2 + t'  0" using t'  0 t2  0 by auto
          ultimately show ?thesis by metis
        next
          case True
          from critical_empty_intro[OF no_consts t1(3) _ this] t1 have "((v  t1)  ?t)  ?R'" by auto
          from region_unique[OF less(2) this] less(2) valid t2 show ?thesis
          by (auto simp: cval_add_def)
        qed
      qed
    qed
  qed
qed

text ‹
  Finally, we can put the two pieces together: for a non-negative shift @{term t}, we first shift
  @{term "floor t"} and then @{term "frac t"}.
›

lemma set_of_regions:
  fixes X k
  defines "  {region X I r |I r. valid_region X k I r}"
  assumes "R  " "v  R" "R'  Succ  R" "finite X"
  shows " t0. [v  t]⇩ = R'" using assms
proof -
  from assms(4) obtain v' t where v': "v'  R" "R'  " "0  t" "R' = [v'  t]⇩" by fastforce
  obtain t1 :: int where t1: "t1 = floor t" by auto
  with v'(3) have "t1  0" by auto
  from int_shift_equiv[OF v'(1) v  R assms(2)[unfolded ℛ_def] this] ℛ_def
  have *: "(v  t1)  [v'  t1]⇩" by auto
  let ?v = "(v  t1)"
  let ?t2 = "frac t"
  have frac: "0  ?t2" "?t2 < 1" by (auto simp: frac_lt_1)
  let ?R = "[v'  t1]⇩"
  from regions_closed[OF _ assms(2) v'(1)] t1  0 ℛ_def have "?R  " by auto
  with assms obtain I r where R: "?R = region X I r" "valid_region X k I r" by auto
  with * have v: "?v  region X I r" by auto
  from R regions_closed'[OF _ assms(2) v'(1)] t1  0 ℛ_def have "(v'  t1)  region X I r" by auto
  from set_of_regions_lt_1[OF R(2) this v assms(5) frac] ℛ_def obtain t2 where
    "t2  0" "(?v  t2)  [(v'  t1)  ?t2]⇩"
  by auto
  moreover from t1 have "(v  (t1 + t2)) = (?v  t2)" "v'  t = ((v'  t1)  ?t2)"
  by (auto simp: frac_def cval_add_def)
  ultimately have "(v  (t1 + t2))  [v'  t]⇩" "t1 + t2  0" using t1  0 t2  0 by auto
  with region_unique[OF _ this(1)] v'(2,4) ℛ_def show ?thesis by blast
qed


section ‹Compability With Clock Constraints›

definition ccval ("_" [100]) where "ccval cc  {v. v  cc}"

definition ccompatible
where
  "ccompatible  cc   R  . R  ccval cc  ccval cc  R = {}"

lemma ccompatible1:
  fixes X k fixes c :: real
  defines "  {region X I r |I r. valid_region X k I r}"
  assumes "c  k x" "c  " "x  X"
  shows "ccompatible  (EQ x c)" using assms unfolding ccompatible_def
proof (auto, goal_cases)
  case A: (1 I r v u)
  from A(3) obtain d where d: "c = of_nat d" unfolding Nats_def by auto
  with A(8) have u: "u x = c" "u x = d" unfolding ccval_def by auto
  have "I x = Const d"
  proof (cases "I x", goal_cases)
    case (1 c')
    with A(4,9) have "u x = c'" by fastforce
    with 1 u show ?case by auto
  next
    case (2 c')
    with A(4,9) have "c' < u x" "u x < c' + 1" by fastforce+
    with 2 u show ?case by auto
  next
    case (3 c')
    with A(4,9) have "c' < u x" by fastforce
    moreover from 3 A(4,5) have "c'  k x" by fastforce
    ultimately show ?case using u A(2) by auto
  qed
  with A(4,6) d have "v x = c" by fastforce
  with A(3,5) have "v  EQ x c" by auto
  with A(7) show False unfolding ccval_def by auto
qed

lemma ccompatible2:
  fixes X k fixes c :: real
  defines "  {region X I r |I r. valid_region X k I r}"
  assumes "c  k x" "c  " "x  X"
  shows "ccompatible  (LT x c)" using assms unfolding ccompatible_def
proof (auto, goal_cases)
  case A: (1 I r v u)
  from A(3) obtain d :: nat where d: "c = of_nat d" unfolding Nats_def by blast
  with A(8) have u: "u x < c" "u x < d" unfolding ccval_def by auto
  have "v x < c"
  proof (cases "I x", goal_cases)
    case (1 c')
    with A(4,6,9) have "u x = c'" "v x = c'" by fastforce+
    with u show "v x < c" by auto
  next
    case (2 c')
    with A(4,6,9) have B: "c' < u x" "u x < c' + 1" "c' < v x" "v x < c' + 1" by fastforce+
    with u A(3) have "c' + 1  d" by auto
    with d have "c' + 1  c" by auto
    with B u show "v x < c" by auto
  next
    case (3 c')
    with A(4,9) have "c' < u x" by fastforce
    moreover from 3 A(4,5) have "c'  k x" by fastforce
    ultimately show ?case using u A(2) by auto
  qed
  with A(4,6) have "v  LT x c" by auto
  with A(7) show False unfolding ccval_def by auto
qed

lemma ccompatible3:
  fixes X k fixes c :: real
  defines "  {region X I r |I r. valid_region X k I r}"
  assumes "c  k x" "c  " "x  X"
  shows "ccompatible  (LE x c)" using assms unfolding ccompatible_def
proof (auto, goal_cases)
  case A: (1 I r v u)
  from A(3) obtain d :: nat where d: "c = of_nat d" unfolding Nats_def by blast
  with A(8) have u: "u x  c" "u x  d" unfolding ccval_def by auto
  have "v x  c"
  proof (cases "I x", goal_cases)
    case (1 c') with A(4,6,9) u show ?case by fastforce
  next
    case (2 c')
    with A(4,6,9) have B: "c' < u x" "u x < c' + 1" "c' < v x" "v x < c' + 1" by fastforce+
    with u A(3) have "c' + 1  d" by auto
    with d u A(3) have "c' + 1  c" by auto
    with B u show "v x  c" by auto
  next
    case (3 c')
    with A(4,9) have "c' < u x" by fastforce
    moreover from 3 A(4,5) have "c'  k x" by fastforce
    ultimately show ?case using u A(2) by auto
  qed
  with A(4,6) have "v  LE x c" by auto
  with A(7) show False unfolding ccval_def by auto
qed

lemma ccompatible4:
  fixes X k fixes c :: real
  defines "  {region X I r |I r. valid_region X k I r}"
  assumes "c  k x" "c  " "x  X"
  shows "ccompatible  (GT x c)" using assms unfolding ccompatible_def
proof (auto, goal_cases)
  case A: (1 I r v u)
  from A(3) obtain d :: nat where d: "c = of_nat d" unfolding Nats_def by blast
  with A(8) have u: "u x > c" "u x > d" unfolding ccval_def by auto
  have "v x > c"
  proof (cases "I x", goal_cases)
    case (1 c') with A(4,6,9) u show ?case by fastforce
  next
    case (2 c')
    with A(4,6,9) have B: "c' < u x" "u x < c' + 1" "c' < v x" "v x < c' + 1" by fastforce+
    with d u have "c'  c" by auto
    with B u show "v x > c" by auto
  next
    case (3 c')
    with A(4,6) have "c' < v x" by fastforce
    moreover from 3 A(4,5) have "c'  k x" by fastforce
    ultimately show ?case using A(2) u(1) by auto
  qed
  with A(4,6) have "v  GT x c" by auto
  with A(7) show False unfolding ccval_def by auto
qed

lemma ccompatible5:
  fixes X k fixes c :: real
  defines "  {region X I r |I r. valid_region X k I r}"
  assumes "c  k x" "c  " "x  X"
  shows "ccompatible  (GE x c)" using assms unfolding ccompatible_def
proof (auto, goal_cases)
  case A: (1 I r v u)
  from A(3) obtain d :: nat where d: "c = of_nat d" unfolding Nats_def by blast
  with A(8) have u: "u x  c" "u x  d" unfolding ccval_def by auto
  have "v x  c"
  proof (cases "I x", goal_cases)
    case (1 c') with A(4,6,9) u show ?case by fastforce
  next
    case (2 c')
    with A(4,6,9) have B: "c' < u x" "u x < c' + 1" "c' < v x" "v x < c' + 1" by fastforce+
    with d u have "c'  c" by auto
    with B u show "v x  c" by auto
  next
    case (3 c')
    with A(4,6) have "c' < v x" by fastforce
    moreover from 3 A(4,5) have "c'  k x" by fastforce
    ultimately show ?case using A(2) u(1) by auto
  qed
  with A(4,6) have "v  GE x c" by auto
  with A(7) show False unfolding ccval_def by auto
qed

lemma ccompatible:
  fixes X k fixes c :: nat
  defines "  {region X I r |I r. valid_region X k I r}"
  assumes "(x,m)  collect_clock_pairs cc. m  k x  x  X  m  "
  shows "ccompatible  cc" using assms
proof (induction cc)
  case (AND cc1 cc2)
  then have IH: "ccompatible  cc1" "ccompatible  cc2" by auto
  moreover have "AND cc1 cc2 = cc1  cc2" unfolding ccval_def by auto
  ultimately show ?case unfolding ccompatible_def by auto
qed (auto intro: ccompatible1 ccompatible2 ccompatible3 ccompatible4 ccompatible5)


section ‹Compability with Resets›

definition region_set
where
  "region_set R x c = {v(x := c) | v. v  R}"

lemma region_set_id:
  fixes X k
  defines "  {region X I r |I r. valid_region X k I r}"
  assumes "R  " "v  R" "finite X" "0  c" "c  k x" "x  X"
  shows "[v(x := c)]⇩ = region_set R x c" "[v(x := c)]⇩  " "v(x := c)  [v(x := c)]⇩"
proof -
  from assms obtain I r where R: "R = region X I r" "valid_region X k I r" "v  region X I r" by auto
  let ?I = "λ y. if x = y then Const c else I y"
  let ?r = "{(y,z)  r. x  y  x  z}"
  let ?X0 = "{x  X.  c. I x = Intv c}"
  let ?X0' = "{x  X.  c. ?I x = Intv c}"

  from R(2) have refl: "refl_on ?X0 r" and trans: "trans r" and total: "total_on ?X0 r" by auto

  have valid: "valid_region X k ?I ?r"
  proof
    show "?X0 - {x} = ?X0'" by auto
  next
    from refl show "refl_on (?X0 - {x}) ?r" unfolding refl_on_def by auto
  next
    from trans show "trans ?r" unfolding trans_def by blast
  next
    from total show "total_on (?X0 - {x}) ?r" unfolding total_on_def by auto
  next
    from R(2) have " x  X. valid_intv (k x) (I x)" by auto
    with c  k x show " x  X. valid_intv (k x) (?I x)" by auto
  qed

  { fix v assume v: "v  region_set R x c"
    with R(1) obtain v' where v': "v'  region X I r" "v = v'(x := c)" unfolding region_set_def by auto
    have "v  region X ?I ?r"
    proof (standard, goal_cases)
      case 1
      from v' 0  c show ?case by auto
    next
      case 2
      from v' show ?case
      proof (auto, goal_cases)
        case (1 y)
        then have "intv_elem y v' (I y)" by auto
        with x  y show "intv_elem y (v'(x := c)) (I y)" by (cases "I y") auto
      qed
    next
      show "?X0 - {x} = ?X0'" by auto
    next
      from v' show " y  ?X0 - {x}.  z  ?X0 - {x}. (y,z)  ?r  frac (v y)  frac (v z)" by auto
    qed
  } moreover
  { fix v assume v: "v  region X ?I ?r"
    have " c. v(x := c)  region X I r"
    proof (cases "I x")
      case (Const c)
      from R(2) have "c  0" by auto
      let ?v = "v(x := c)"
      have "?v  region X I r"
      proof (standard, goal_cases)
        case 1
        from c0 v show ?case by auto
      next
        case 2
        show ?case
        proof (auto, goal_cases)
          case (1 y)
          with v have "intv_elem y v (?I y)" by fast
          with Const show "intv_elem y ?v (I y)" by (cases "x = y", auto) (cases "I y", auto)
        qed
      next
        from Const show "?X0' = ?X0" by auto
        with refl have "r  ?X0' × ?X0'" unfolding refl_on_def by auto
        then have r: "?r = r" by auto
        from v have " y  ?X0'.  z  ?X0'. (y,z)  ?r  frac (v y)  frac (v z)" by fastforce
        with r show " y  ?X0'.  z  ?X0'. (y,z)  r  frac (?v y)  frac (?v z)"
        by auto
      qed
      then show ?thesis by auto
    next
      case (Greater c)
      from R(2) have "c  0" by auto
      let ?v = "v(x := c + 1)"
      have "?v  region X I r"
      proof (standard, goal_cases)
        case 1
        from c0 v show ?case by auto
      next
        case 2
        show ?case
        proof (standard, goal_cases)
          case (1 y)
          with v have "intv_elem y v (?I y)" by fast
          with Greater show "intv_elem y ?v (I y)" by (cases "x = y", auto) (cases "I y", auto)
        qed
      next
        from Greater show "?X0' = ?X0" by auto
        with refl have "r  ?X0' × ?X0'" unfolding refl_on_def by auto
        then have r: "?r = r" by auto
        from v have " y  ?X0'.  z  ?X0'. (y,z)  ?r  frac (v y)  frac (v z)" by fastforce
        with r show " y  ?X0'.  z  ?X0'. (y,z)  r  frac (?v y)  frac (?v z)"
        by auto
      qed
      then show ?thesis by auto
    next
      case (Intv c)
      from R(2) have "c  0" by auto
      let ?L = "{frac (v y) | y. y  ?X0  x  y  (y,x)  r}"
      let ?U = "{frac (v y) | y. y  ?X0  x  y  (x,y)  r}"
      let ?l = "if ?L  {} then c + Max ?L else if ?U  {} then c else c + 0.5"
      let ?u = "if ?U  {} then c + Min ?U else if ?L  {} then c + 1 else c + 0.5"
      from ‹finite X have fin: "finite ?L" "finite ?U" by auto
      { fix y assume y: "y  ?X0" "x  y" "(y, x)  r"
        then have L: "frac (v y)  ?L" by auto
        with Max_in[OF fin(1)] have In: "Max ?L  ?L" by auto
        then have "frac (Max ?L) = (Max ?L)" using frac_idempotent by fastforce
        from Max_ge[OF fin(1) L] have "frac (v y)  Max ?L" .
        also have " = frac (Max ?L)" using In frac_idempotent[symmetric] by fastforce
        also have " = frac (c + Max ?L)" by (auto simp: frac_nat_add_id)
        finally have "frac (v y)  frac ?l" using L by auto
      } note L_bound = this
      { fix y assume y: "y  ?X0" "x  y" "(x,y)  r"
        then have U: "frac (v y)  ?U" by auto
        with Min_in[OF fin(2)] have In: "Min ?U  ?U" by auto
        then have "frac (Min ?U) = (Min ?U)" using frac_idempotent by fastforce
        have "frac (c + Min ?U) = frac (Min ?U)" by (auto simp: frac_nat_add_id)
        also have " = Min ?U" using In frac_idempotent by fastforce
        also from Min_le[OF fin(2) U] have "Min ?U  frac (v y)" .
        finally have "frac ?u  frac (v y)" using U by auto
      } note U_bound = this
      { assume "?L  {}"
        from Max_in[OF fin(1) this] obtain l d where l:
          "Max ?L = frac (v l)" "l  X" "x  l" "I l = Intv d"
        by auto
        with v have "d < v l" "v l < d + 1" by fastforce+
        with nat_intv_frac_gt0[OF this] frac_lt_1 l(1) have "0 < Max ?L" "Max ?L < 1" by auto
        then have "c < c + Max ?L" "c + Max ?L < c + 1" by simp+
      } note L_intv = this
      { assume "?U  {}"
        from Min_in[OF fin(2) this] obtain u d where u:
          "Min ?U = frac (v u)" "u X" "x  u" "I u = Intv d"
        by auto
        with v have "d < v u" "v u < d + 1" by fastforce+
        with nat_intv_frac_gt0[OF this] frac_lt_1 u(1) have "0 < Min ?U" "Min ?U < 1" by auto
        then have "c < c + Min ?U" "c + Min ?U < c + 1" by simp+
      } note U_intv = this
      have l_bound: "c  ?l"
      proof (cases "?L = {}")
        case True
        note T = this
        show ?thesis
        proof (cases "?U = {}")
          case True
          with T show ?thesis by simp
        next
          case False
          with U_intv T show ?thesis by simp
        qed
      next
        case False
        with L_intv show ?thesis by simp
      qed
      have l_bound': "c < ?u"
      proof (cases "?L = {}")
        case True
        note T = this
        show ?thesis
        proof (cases "?U = {}")
          case True
          with T show ?thesis by simp
        next
          case False
          with U_intv T show ?thesis by simp
        qed
      next
        case False
        with U_intv show ?thesis by simp
      qed
      have u_bound: "?u  c + 1"
      proof (cases "?U = {}")
        case True
        note T = this
        show ?thesis
        proof (cases "?L = {}")
          case True
          with T show ?thesis by simp
        next
          case False
          with L_intv T show ?thesis by simp
        qed
      next
        case False
        with U_intv show ?thesis by simp
      qed
      have u_bound': "?l < c + 1"
      proof (cases "?U = {}")
        case True
        note T = this
        show ?thesis
        proof (cases "?L = {}")
          case True
          with T show ?thesis by simp
        next
          case False
          with L_intv T show ?thesis by simp
        qed
      next
        case False
        with L_intv show ?thesis by simp
      qed
      have frac_c: "frac c = 0" "frac (c+1) = 0" by auto
      have l_u: "?l  ?u"
      proof (cases "?L = {}")
        case True
        note T = this
        show ?thesis
        proof (cases "?U = {}")
          case True
          with T show ?thesis by simp
        next
          case False
          with T show ?thesis using Min_in[OF fin(2) False] by (auto simp: frac_c)
        qed
      next
        case False
        with Max_in[OF fin(1) this] have l: "?l = c + Max ?L" "Max ?L  ?L" by auto
        note F = False
        from l(1) have *: "Max ?L < 1" using False L_intv(2) by linarith
        show ?thesis
        proof (cases "?U = {}")
          case True
          with F l * show ?thesis by simp
        next
          case False
          from Min_in[OF fin(2) this] l(2) obtain l u where l_u:
            "Max ?L = frac (v l)" "Min ?U = frac (v u)" "l  ?X0" "u  ?X0" "(l,x)  r" "(x,u)  r"
            "x  l" "x  u"
          by auto
          from trans l_u(5-) have "(l,u)  ?r" unfolding trans_def by blast
          with l_u(1-4) v have *: "Max ?L  Min ?U" by fastforce
          with l_u(1,2) have "frac (Max ?L)  frac (Min ?U)" by (simp add: frac_idempotent)
          with frac_nat_add_id l(1) False have "frac ?l  frac ?u" by simp
          with l(1) * False show ?thesis by simp
        qed
      qed
      obtain d where d: "d = (?l + ?u) / 2" by blast
      with l_u have d2: "?l  d" "d  ?u" by simp+
      from d l_bound l_bound' u_bound u_bound' have d3: "c < d" "d < c + 1" "d  0" by simp+
      have "floor ?l = c"
      proof (cases "?L = {}")
        case False
        from L_intv[OF False] have "0  Max ?L" "Max ?L < 1" by auto
        from floor_nat_add_id[OF this] False show ?thesis by simp
      next
        case True
        note T = this
        show ?thesis
        proof (cases "?U = {}")
          case True
          with T show ?thesis by (simp)
        next
          case False
          from U_intv[OF False] have "0  Min ?U" "Min ?U < 1" by auto
          from floor_nat_add_id[OF this] T False show ?thesis by simp
        qed
      qed
      have floor_u: "floor ?u = (if ?U = {}  ?L  {} then c + 1 else c)"
      proof (cases "?U = {}")
        case False
        from U_intv[OF False] have "0  Min ?U" "Min ?U < 1" by auto
        from floor_nat_add_id[OF this] False show ?thesis by simp
      next
        case True
        note T = this
        show ?thesis
        proof (cases "?L = {}")
          case True
          with T show ?thesis by (simp)
        next
          case False
          from L_intv[OF False] have "0  Max ?L" "Max ?L < 1" by auto
          from floor_nat_add_id[OF this] T False show ?thesis by (auto)
        qed
      qed
      { assume "?L  {}" "?U  {}"
        from Max_in[OF fin(1) ?L  {}] obtain w where w:
          "w  ?X0" "x  w" "(w,x)  r" "Max ?L = frac (v w)"
        by auto
        from Min_in[OF fin(2) ?U  {}] obtain z where z:
          "z  ?X0" "x  z" "(x,z)  r" "Min ?U = frac (v z)"
        by auto
        from w z trans have "(w,z)  r" unfolding trans_def by blast
        with v w z have "Max ?L  Min ?U" by fastforce
      } note l_le_u = this
      { fix y assume y: "y  ?X0" "x  y"
        from total y x  X Intv have total: "(x,y)  r  (y,x)  r" unfolding total_on_def by auto
        have "frac (v y) = frac d  (y,x)  r  (x,y)  r"
        proof safe
          assume A: "(y,x)  r" "(x,y)  r"
          from L_bound[OF y A(1)] U_bound[OF y A(2)] have *:
            "frac (v y)  frac ?l" "frac ?u  frac (v y)"
          by auto
          from A y have **: "?L  {}" "?U  {}" by auto
          with L_intv[OF this(1)] U_intv[OF this(2)] have "frac ?l = Max ?L" "frac ?u = Min ?U"
          by (auto simp: frac_nat_add_id frac_eq)
          with * ** l_le_u have "frac ?l = frac ?u" "frac (v y) = frac ?l" by auto
          with d have "d = ((floor ?l + floor ?u) + (frac (v y) + frac (v y))) / 2"
          unfolding frac_def by auto
          also have " = c + frac (v y)" using ‹floor ?l = c floor_u ?U  {} by auto
          finally show "frac (v y) = frac d" using frac_nat_add_id frac_idempotent by metis
        next
          assume A: "frac (v y) = frac d"
          show "(y, x)  r"
          proof (rule ccontr)
            assume B: "(y,x)  r"
            with total have B': "(x,y)  r" by auto
            from U_bound[OF y this] have u_y:"frac ?u  frac (v y)" by auto
            from y B' have U: "?U  {}" and "frac (v y)  ?U" by auto
            then have u: "frac ?u = Min ?U" using Min_in[OF fin(2) ?U  {}]
            by (auto simp: frac_nat_add_id frac_idempotent)
            show False
            proof (cases "?L = {}")
              case True
              from U_intv[OF U] have "0 < Min ?U" "Min ?U < 1" by auto
              then have *: "frac (Min ?U / 2) = Min ?U / 2" unfolding frac_eq by simp
              from d U True have "d = ((c + c) + Min ?U) / 2" by auto
              also have " = c + Min ?U / 2" by simp
              finally have "frac d = Min ?U / 2" using * by (simp add: frac_nat_add_id)
              also have " < Min ?U" using 0 < Min ?U by auto
              finally have "frac d < frac ?u" using u by auto
              with u_y A show False by auto
            next
              case False
              then have l:  "?l = c + Max ?L" by simp
              from Max_in[OF fin(1) ?L  {}]
              obtain w where w:
                "w  ?X0" "x  w" "(w,x)  r" "Max ?L = frac (v w)"
              by auto
              with (y,x)  r trans have **: "(y,w)  r" unfolding trans_def by blast
              from Min_in[OF fin(2) ?U  {}] Max_in[OF fin(1) ?L  {}] frac_lt_1
              have "0  Max ?L" "Max ?L < 1" "0  Min ?U" "Min ?U < 1" by auto
              then have "0  (Max ?L + Min ?U) / 2" "(Max ?L + Min ?U) / 2 < 1" by auto
              then have ***: "frac ((Max ?L + Min ?U) / 2) = (Max ?L + Min ?U) / 2" unfolding frac_eq ..
              from y w have "y  ?X0'" "w  ?X0'" by auto
              with v ** have lt: "frac (v y) > frac (v w)" by fastforce
              from d U l have "d = ((c + c) + (Max ?L + Min ?U))/2" by auto
              also have " = c + (Max ?L + Min ?U) / 2" by simp
              finally have "frac d = frac ((Max ?L + Min ?U) / 2)" by (simp add: frac_nat_add_id)
              also have " = (Max ?L + Min ?U) / 2" using *** by simp
              also have " < (frac (v y) + Min ?U) / 2" using lt w(4) by auto
              also have "  frac (v y)" using Min_le[OF fin(2) ‹frac (v y)  ?U] by auto
              finally show False using A by auto
            qed
          qed
        next
          assume A: "frac (v y) = frac d"
          show "(x, y)  r"
          proof (rule ccontr)
            assume B: "(x,y)  r"
            with total have B': "(y,x)  r" by auto
            from L_bound[OF y this] have l_y:"frac ?l  frac (v y)" by auto
            from y B' have L: "?L  {}" and "frac (v y)  ?L" by auto
            then have l: "frac ?l = Max ?L" using Max_in[OF fin(1) ?L  {}]
            by (auto simp: frac_nat_add_id frac_idempotent)
            show False
            proof (cases "?U = {}")
              case True
              from L_intv[OF L] have *: "0 < Max ?L" "Max ?L < 1" by auto
              from d L True have "d = ((c + c) + (1 + Max ?L)) / 2" by auto
              also have " = c + (1 + Max ?L) / 2" by simp
              finally have "frac d = frac ((1 + Max ?L) / 2)" by (simp add: frac_nat_add_id)
              also have " = (1 + Max ?L) / 2" using * unfolding frac_eq by auto
              also have " > Max ?L" using * by auto
              finally have "frac d > frac ?l" using l by auto
              with l_y A show False by auto
            next
              case False
              then have u: "?u = c + Min ?U" by simp
              from Min_in[OF fin(2) ?U  {}]
              obtain w where w:
                "w  ?X0" "x  w" "(x,w)  r" "Min ?U = frac (v w)"
              by auto
              with (x,y)  r trans have **: "(w,y)  r" unfolding trans_def by blast
              from Min_in[OF fin(2) ?U  {}] Max_in[OF fin(1) ?L  {}] frac_lt_1
              have "0  Max ?L" "Max ?L < 1" "0  Min ?U" "Min ?U < 1" by auto
              then have "0  (Max ?L + Min ?U) / 2" "(Max ?L + Min ?U) / 2 < 1" by auto
              then have ***: "frac ((Max ?L + Min ?U) / 2) = (Max ?L + Min ?U) / 2" unfolding frac_eq ..
              from y w have "y  ?X0'" "w  ?X0'" by auto
              with v ** have lt: "frac (v y) < frac (v w)" by fastforce
              from d L u have "d = ((c + c) + (Max ?L + Min ?U))/2" by auto
              also have " = c + (Max ?L + Min ?U) / 2" by simp
              finally have "frac d = frac ((Max ?L + Min ?U) / 2)" by (simp add: frac_nat_add_id)
              also have " = (Max ?L + Min ?U) / 2" using *** by simp
              also have " > (Max ?L + frac (v y)) / 2" using lt w(4) by auto
              finally have "frac d > frac (v y)" using Max_ge[OF fin(1) ‹frac (v y)  ?L] by auto
              then show False using A by auto
            qed
          qed
        qed
      } note d_frac_equiv = this
      have frac_l: "frac ?l  frac d"
      proof (cases "?L = {}")
        case True
        note T = this
        show ?thesis
        proof (cases "?U = {}")
          case True
          with T have "?l = ?u" by auto
          with d have "d = ?l" by auto
          then show ?thesis by auto
        next
          case False
          with T have "frac ?l = 0" by auto
          moreover have "frac d  0" by auto
          ultimately show ?thesis by linarith
        qed
      next
        case False
        note F = this
        then have l: "?l = c + Max ?L" "frac ?l = Max ?L" using Max_in[OF fin(1) ?L  {}]
        by (auto simp: frac_nat_add_id frac_idempotent)
        from L_intv[OF F] have *: "0 < Max ?L" "Max ?L < 1" by auto
        show ?thesis
        proof (cases "?U = {}")
          case True
          from True F have "?u = c + 1" by auto
          with l d have "d = ((c + c) + (Max ?L + 1)) / 2" by auto
          also have " = c + (1 + Max ?L) / 2" by simp
          finally have "frac d = frac ((1 + Max ?L) / 2)" by (simp add: frac_nat_add_id)
          also have " = (1 + Max ?L) / 2" using * unfolding frac_eq by auto
          also have " > Max ?L" using * by auto
          finally show "frac d  frac ?l" using l by auto
        next
          case False
          then have u: "?u = c + Min ?U" "frac ?u = Min ?U" using Min_in[OF fin(2) False]
          by (auto simp: frac_nat_add_id frac_idempotent)
          from U_intv[OF False] have **: "0 < Min ?U" "Min ?U < 1" by auto
          from l u d have "d = ((c + c) + (Max ?L + Min ?U)) / 2" by auto
          also have " = c + (Max ?L + Min ?U) / 2" by simp
          finally have "frac d = frac ((Max ?L + Min ?U) / 2)" by (simp add: frac_nat_add_id)
          also have " = (Max ?L + Min ?U) / 2" using * ** unfolding frac_eq by auto
          also have "  Max ?L" using l_le_u[OF F False] by auto
          finally show ?thesis using l by auto
        qed
      qed
      have frac_u: "?U  {}  ?L = {}  frac d  frac ?u"
      proof (cases "?U = {}")
        case True
        note T = this
        show ?thesis
        proof (cases "?L = {}")
          case True
          with T have "?l = ?u" by auto
          with d have "d = ?u" by auto
          then show ?thesis by auto
        next
          case False
          with T show ?thesis by auto
        qed
      next
        case False
        note F = this
        then have u: "?u = c + Min ?U" "frac ?u = Min ?U" using Min_in[OF fin(2) ?U  {}]
        by (auto simp: frac_nat_add_id frac_idempotent)
        from U_intv[OF F] have *: "0 < Min ?U" "Min ?U < 1" by auto
        show ?thesis
        proof (cases "?L = {}")
          case True
          from True F have "?l = c" by auto
          with u d have "d = ((c + c) + Min ?U) / 2" by auto
          also have " = c + Min ?U / 2" by simp
          finally have "frac d = frac (Min ?U / 2)" by (simp add: frac_nat_add_id)
          also have " = Min ?U / 2" unfolding frac_eq using * by auto
          also have "  Min ?U" using 0 < Min ?U by auto
          finally have "frac d  frac ?u" using u by auto
          then show ?thesis by auto
        next
          case False
          then have l: "?l = c + Max ?L" "frac ?l = Max ?L" using Max_in[OF fin(1) False]
          by (auto simp: frac_nat_add_id frac_idempotent)
          from L_intv[OF False] have **: "0 < Max ?L" "Max ?L < 1" by auto
          from l u d have "d = ((c + c) + (Max ?L + Min ?U)) / 2" by auto
          also have " = c + (Max ?L + Min ?U) / 2" by simp
          finally have "frac d = frac ((Max ?L + Min ?U) / 2)" by (simp add: frac_nat_add_id)
          also have " = (Max ?L + Min ?U) / 2" using * ** unfolding frac_eq by auto
          also have "  Min ?U" using l_le_u[OF False F] by auto
          finally show ?thesis using u by auto
        qed
      qed
      have " y  ?X0 - {x}. (y,x)  r  frac (v y)  frac d"
      proof (safe, goal_cases)
        case (1 y k)
        with L_bound[of y] frac_l show ?case by auto
      next
        case (2 y k)
        show ?case
        proof (rule ccontr, goal_cases)
          case 1
          with total 2 x  X Intv have "(x,y)  r" unfolding total_on_def by auto
          with 2 U_bound[of y] have "?U  {}" "frac ?u  frac (v y)" by auto
          with frac_u have "frac d  frac (v y)" by auto
          with 2 d_frac_equiv 1 show False by auto
        qed
      qed
      moreover have " y  ?X0 - {x}. (x,y)  r  frac d  frac (v y)"
      proof (safe, goal_cases)
        case (1 y k)
        then have "?U  {}" by auto
        with 1 U_bound[of y] frac_u show ?case by auto
      next
        case (2 y k)
        show ?case
        proof (rule ccontr, goal_cases)
          case 1
          with total 2 x  X Intv have "(y,x)  r" unfolding total_on_def by auto
          with 2 L_bound[of y] have "frac (v y)  frac ?l" by auto
          with frac_l have "frac (v y)  frac d" by auto
          with 2 d_frac_equiv 1 show False by auto
        qed
      qed
      ultimately have d:
        "c < d" "d < c + 1" " y  ?X0 - {x}. (y,x)  r  frac (v y)  frac d"
        " y  ?X0 - {x}. (x,y)  r  frac d  frac (v y)"
      using d3 by auto
      let ?v = "v(x := d)"
      have "?v  region X I r"
      proof (standard, goal_cases)
        case 1
        from d0 v show ?case by auto
      next
        case 2
        show ?case
        proof (safe, goal_cases)
          case (1 y)
          with v have "intv_elem y v (?I y)" by fast
          with Intv d(1,2) show "intv_elem y ?v (I y)" by (cases "x = y", auto) (cases "I y", auto)
        qed
      next
        from x  X Intv show "?X0'  {x} = ?X0" by auto
        with refl have "r  (?X0'  {x}) × (?X0'  {x})" unfolding refl_on_def by auto
        have " x  ?X0'.  y  ?X0'. (x,y)  r  (x,y)  ?r" by auto
        with v have " x  ?X0'.  y  ?X0'. (x,y)  r  frac (v x)  frac (v y)" by fastforce
        then have " x  ?X0'.  y  ?X0'. (x,y)  r  frac (?v x)  frac (?v y)" by auto
        with d(3,4) show " y  ?X0'  {x}.  z  ?X0'  {x}. (y,z)  r  frac (?v y)  frac (?v z)"
        proof (auto, goal_cases)
          case 1
          from refl x  X Intv show ?case by (auto simp: refl_on_def)
        qed
      qed
      then show ?thesis by auto
    qed
    then obtain d where "v(x := d)  R" using R by auto
    then have "(v(x := d))(x := c)  region_set R x c" unfolding region_set_def by blast
    moreover from v x  X have "(v(x := d))(x := c) = v" by fastforce
    ultimately have "v  region_set R x c" by simp
  }

  ultimately have "region_set R x c = region X ?I ?r" by blast
  with valid ℛ_def have *: "region_set R x c  " by auto
  moreover from assms have **: "v (x := c)  region_set R x c" unfolding region_set_def by auto
  ultimately show "[v(x := c)]⇩ = region_set R x c" "[v(x := c)]⇩  " "v(x := c)  [v(x := c)]⇩"
  using region_unique[OF _ ** *] ℛ_def by auto
qed

definition region_set'
where
  "region_set' R r c = {[r  c]v | v. v  R}"

lemma region_set'_id:
  fixes X k and c :: nat
  defines "  {region X I r |I r. valid_region X k I r}"
  assumes "R  " "v  R" "finite X" "0  c" " x  set r. c  k x" "set r  X"
  shows "[[r  c]v]⇩ = region_set' R r c  [[r  c]v]⇩    [r  c]v  [[r  c]v]⇩" using assms
proof (induction r)
  case Nil
  from regions_closed[OF _ Nil(2,3)] regions_closed'[OF _ Nil(2,3)] region_unique[OF _ Nil(3,2)] Nil(1)
  have "[v]⇩ = R" "[v  0]⇩  " "(v  0)  [v  0]⇩" by auto
  then show ?case unfolding region_set'_def cval_add_def by simp
next
  case (Cons x xs)
  then have "[[xsc]v]⇩ = region_set' R xs c" "[[xsc]v]⇩  " "[xsc]v  [[xsc]v]⇩" by force+
  note IH = this[unfolded ℛ_def]
  let ?v = "([xsc]v)(x := c)"
  from region_set_id[OF IH(2,3) ‹finite X c  0, of x] ℛ_def Cons.prems(5,6)
  have "[?v]⇩ = region_set ([[xsreal c]v]⇩) x c" "[?v]⇩  " "?v  [?v]⇩" by auto
  moreover have "region_set' R (x # xs) (real c) = region_set ([[xsreal c]v]⇩) x c"
  unfolding region_set_def region_set'_def
  proof (safe, goal_cases)
    case (1 y u)
    let ?u = "[xsreal c]u"
    have "[x # xsreal c]u = ?u(x := real c)" by auto
    moreover from IH(1) 1 have "?u  [[xsreal c]v]⇩" unfolding ℛ_def region_set'_def by auto
    ultimately show ?case by auto
  next
    case (2 y u)
    with IH(1)[unfolded region_set'_def ℛ_def[symmetric]] show ?case by auto
  qed
  moreover have "[x # xsreal c]v = ?v" by simp
  ultimately show ?case by presburger
qed

section ‹A Semantics Based on Regions›

subsection ‹Single step›

inductive step_r ::
  "('a, 'c, t, 's) ta  ('c, t) zone set  's  ('c, t) zone  's  ('c, t) zone  bool"
("_,_  _, _  _, _" [61,61,61,61] 61)
where
  step_t_r:
  " = {region X I r |I r. valid_region X k I r}; valid_abstraction A X k; R  ; R'  Succ  R;
    R  inv_of A l; R'  inv_of A l  A,  l,R  l,R'" |
  step_a_r:
  " = {region X I r |I r. valid_region X k I r}; valid_abstraction A X k; A  lg,a,r l'; R  
     A,  l,R  l',region_set' (R  {u. u  g}) r 0  {u. u  inv_of A l'}"

inductive_cases[elim!]: "A,  l, u  l', u'"

declare step_r.intros[intro]

lemma region_cover':
  assumes " = {region X I r |I r. valid_region X k I r}" and "xX. 0  v x"
  shows "v  [v]⇩" "[v]⇩  "
proof -
  from region_cover[OF assms(2), of k] assms obtain R where R: "R  " "v  R" by auto
  from regions_closed'[OF assms(1) R, of 0] show "v  [v]⇩" unfolding cval_add_def by auto
  from regions_closed[OF assms(1) R, of 0] show "[v]⇩  " unfolding cval_add_def by auto
qed

lemma step_r_complete_aux:
  fixes R r A l' g
  defines "R'  region_set' (R  {u. u  g}) r 0  {u. u  inv_of A l'}"
  assumes " = {region X I r |I r. valid_region X k I r}"
    and "valid_abstraction A X k"
    and "u  R"
    and "R  "
    and "A  lg,a,r l'"
    and "u  g"
    and "[r0]u  inv_of A l'"
  shows "R = R  {u. u  g}  R' = region_set' R r 0  R'  "
proof -
  note A = assms(2-)
  from A(2) have *:
    "(x, m)clkp_set A. m  real (k x)  x  X  m  "
    "collect_clkvt (trans_of A)  X"
    "finite X"
  by (fastforce elim: valid_abstraction.cases)+
  from A(5) *(2) have r: "set r  X" unfolding collect_clkvt_def by fastforce
  from *(1) A(5) have "(x, m)collect_clock_pairs g. m  real (k x)  x  X  m  "
  unfolding clkp_set_def collect_clkt_def by fastforce
  from ccompatible[OF this, folded A(1)] A(3,4,6) have "R  g"
  unfolding ccompatible_def ccval_def by blast
  then have R_id: "R  {u. u  g} = R" unfolding ccval_def by auto
  from region_set'_id[OF A(4)[unfolded A(1)] A(3) *(3) _ _ r, of 0, folded A(1)]
  have **:
    "[[r0]u]⇩ = region_set' R r 0" "[[r0]u]⇩  " "[r0]u  [[r0]u]⇩"
  by auto
  let ?R = "[[r0]u]⇩"
  from *(1) A(5) have ***:
    "(x, m)  collect_clock_pairs (inv_of A l'). m  real (k x)  x  X  m  "
  unfolding inv_of_def clkp_set_def collect_clki_def by fastforce
  from ccompatible[OF this, folded A(1)] **(2-) A(7) have "?R  inv_of A l'"
  unfolding ccompatible_def ccval_def by blast
  then have ***: "?R  {u. u  inv_of A l'} = ?R" unfolding ccval_def by auto
  with **(1,2) R_id show ?thesis by (auto simp: R'_def)
qed

lemma step_r_complete:
  "A  l, u  l',u';  = {region X I r |I r. valid_region X k I r}; valid_abstraction A X k;
     x  X. u x  0   R'. A,  l, ([u]⇩)  l',R'  u'  R'  R'  "
proof (induction rule: step.induct, goal_cases)
  case (1 A l u a l' u')
  note A = this
  then obtain g r where u': "u' = [r0]u" "A  lg,a,r l'" "u  g" "u'  inv_of A l'"
  by (cases rule: step_a.cases) auto
  let ?R'= "region_set' (([u]⇩)  {u. u  g}) r 0  {u. u  inv_of A l'}"
  from region_cover'[OF A(2,4)] have R: "[u]⇩  " "u  [u]⇩" by auto
  from step_r_complete_aux[OF A(2,3) this(2,1) u'(2,3)] u'
  have *: "[u]⇩ = ([u]⇩)  {u. u  g}" "?R' = region_set' ([u]⇩) r 0" "?R'  " by auto
  from 1(2,3) have "collect_clkvt (trans_of A)  X" "finite X" by (auto elim: valid_abstraction.cases)
  with u'(2) have r: "set r  X" unfolding collect_clkvt_def by fastforce
  from * u'(1) R(2) have "u'  ?R'" unfolding region_set'_def by auto
  moreover have "A,  l,([u]⇩)  l',?R'" using R(1) A(2,3) u'(2) by auto
  ultimately show ?case using *(3) by meson
next
  case (2 A l u d l' u')
  hence u': "u' = (u  d)" "u  inv_of A l" "u  d  inv_of A l" "0  d" and "l = l'" by auto
  from region_cover'[OF 2(2,4)] have R: "[u]⇩  " "u  [u]⇩" by auto
  from SuccI2[OF 2(2) this(2,1) u'(4), of "[u']⇩"] u'(1) have u'1:
    "[u']⇩  Succ  ([u]⇩)" "[u']⇩  "
  by auto
  from regions_closed'[OF 2(2) R(1,2) u'(4)] u'(1) have u'2: "u'  [u']⇩" by simp
  from 2(3) have *:
    "(x, m)clkp_set A. m  real (k x)  x  X  m  "
    "collect_clkvt (trans_of A)  X"
    "finite X"
  by (fastforce elim: valid_abstraction.cases)+
  from *(1) u'(2) have "(x, m)collect_clock_pairs (inv_of A l). m  real (k x)  x  X  m  "
  unfolding clkp_set_def collect_clki_def inv_of_def by fastforce
  from ccompatible[OF this, folded 2(2)] u'1(2) u'2 u'(1,2,3) R have
    "[u']⇩  inv_of A l" "([u]⇩)  inv_of A l"
  unfolding ccompatible_def ccval_def by auto
  with 2 u'1 R(1) have "A,  l, ([u]⇩)  l,([u']⇩)" by auto
  with u'1(2) u'2 l = l' show ?case by meson
qed

text ‹
  Compare this to lemma step_z_sound›. This version is weaker because for regions we may very well
  arrive at a successor for which not every valuation can be reached by the predecessor.
  This is the case for e.g. the region with only Greater (k x) bounds.
›

lemma step_r_sound:
  "A,  l, R  l',R'   = {region X I r |I r. valid_region X k I r}
   R'  {}  ( u  R.  u'  R'. A  l, u  l',u')"
proof (induction rule: step_r.induct)
  case (step_t_r  X k A R R' l)
  note A = this[unfolded this(1)]
  show ?case
  proof
    fix u assume u: "u  R"
    from set_of_regions[OF A(3) this A(4), folded step_t_r(1)] A(2)
    obtain t where t: "t  0" "[u  t]⇩ = R'" by (auto elim: valid_abstraction.cases)
    with regions_closed'[OF A(1,3) u this(1)] step_t_r(1) have *: "(u  t)  R'" by auto
    with u t(1) A(5,6) have "A  l, u  l,(u  t)" unfolding ccval_def by auto
    with t * show "u'R'. A  l, u  l,u'" by meson
  qed
next
  case A: (step_a_r  X k A l g a r l' R)
  show ?case
  proof
    fix u assume u: "u  R"
    from A(6) obtain v where v: "v  R" "v  g" "[r0]v  inv_of A l'" unfolding region_set'_def by auto
    let ?R' = "region_set' (R  {u. u  g}) r 0  {u. u  inv_of A l'}"
    from step_r_complete_aux[OF A(1,2) v(1) A(4,3) v(2-)] have R:
      "R = R  {u. u  g}" "?R' = region_set' R r 0"
    by auto
    from A have "collect_clkvt (trans_of A)  X" by (auto elim: valid_abstraction.cases)
    with A(3) have r: "set r  X" unfolding collect_clkvt_def by fastforce
    from u R have *: "[r0]u  ?R'" "u  g" "[r0]u  inv_of A l'" unfolding region_set'_def by auto
    with A(3) have "A  l, u  l',[r0]u" apply (intro step.intros(1)) apply rule by auto
    with * show "a?R'. A  l, u  l',a" by meson
  qed
qed

subsection ‹Multi Step›

inductive
  steps_r :: "('a, 'c, t, 's) ta  ('c, t) zone set  's  ('c, t) zone  's  ('c, t) zone  bool"
("_,_  _, _ ↝* _, _" [61,61,61,61,61,61] 61)
where
  refl: "A,  l, R ↝* l, R" |
  step: "A,  l, R ↝* l', R'  A,  l', R'  l'', R''  A,  l, R ↝* l'', R''"

declare steps_r.intros[intro]

lemma steps_alt:
  "A  l, u →* l',u'  A  l', u'  l'',u''  A  l, u →* l'',u''"
by (induction rule: steps.induct) auto

lemma emptiness_preservance: "A,  l, R  l',R'  R = {}  R' = {}"
by (induction rule: step_r.cases) (auto simp: region_set'_def)

lemma emptiness_preservance_steps: "A,  l, R ↝* l',R'  R = {}  R' = {}"
 apply (induction rule: steps_r.induct)
  apply blast
 apply (subst emptiness_preservance)
by blast+

text ‹
  Note how it is important to define the multi-step semantics "the right way round".
  This also the direction Bouyer implies for her implicit induction.
›

lemma steps_r_sound:
  "A,  l, R ↝* l', R'   = {region X I r |I r. valid_region X k I r}
   R'  {}  u  R   u'  R'. A  l, u →* l', u'"
proof (induction rule: steps_r.induct)
  case refl then show ?case by auto
next
  case (step A  l R l' R' l'' R'')
  from emptiness_preservance[OF step.hyps(2)] step.prems have "R'  {}" by fastforce
  with step obtain u' where u': "u'  R'" "A  l, u →* l',u'" by auto
  with step_r_sound[OF step(2,4,5)] obtain u'' where "u''  R''" "A  l', u'  l'',u''" by blast
  with u' show ?case by (auto intro: steps_alt)
qed

lemma steps_r_sound':
  "A,  l, R ↝* l', R'   = {region X I r |I r. valid_region X k I r}
   R'  {}  ( u'  R'.  u  R.  A  l, u →* l', u')"
proof goal_cases
  case 1
  with emptiness_preservance_steps[OF this(1)] obtain u where "u  R" by auto
  with steps_r_sound[OF 1 this] show ?case by auto
qed

lemma single_step_r:
  "A,  l, R  l', R'  A,  l, R ↝* l', R'"
by (metis steps_r.refl steps_r.step)

lemma steps_r_alt:
  "A,  l', R' ↝* l'', R''  A,  l, R  l', R'  A,  l, R ↝* l'', R''"
 apply (induction rule: steps_r.induct)
  apply (rule single_step_r)
by auto

lemma single_step:
  "x1  x2, x3  x4,x5  x1  x2, x3 →* x4,x5"
by (metis steps.intros)

lemma steps_r_complete:
  "A  l, u →* l',u';  = {region X I r |I r. valid_region X k I r}; valid_abstraction A X k;
     x  X. u x  0   R'. A,  l, ([u]⇩) ↝* l',R'  u'  R'"
proof (induction rule: steps.induct)
  case (refl A l u)
  from region_cover'[OF refl(1,3)] show ?case by auto
next
  case (step A l u l' u' l'' u'')
  from step_r_complete[OF step(1,4-6)] obtain R' where R':
    "A,  l, ([u]⇩)  l',R'" "u'  R'" "R'  "
  by auto
  with step(4) u'  R' have "xX. 0  u' x" by auto
  with step obtain R'' where R'': "A,  l', ([u']⇩) ↝* l'',R''" "u''  R''" by auto
  with region_unique[OF step(4) R'(2,3)] R'(1) have "A,  l, ([u]⇩) ↝* l'',R''"
  by (subst steps_r_alt) auto
  with R'' region_cover'[OF step(4,6)] show ?case by auto
qed

end

Theory Closure

theory Closure
  imports Regions
begin

section ‹Correct Approximation of Zones with α›-regions›

locale AlphaClosure =
  fixes X k  and V :: "('c, t) cval set"
  defines "  {region X I r | I r. valid_region X k I r}"
  defines "V  {v .  x  X. v x  0}"
  assumes finite: "finite X"
begin

lemmas set_of_regions_spec = set_of_regions[OF _ _ _ finite, of _ k, folded ℛ_def]
lemmas region_cover_spec = region_cover[of X _ k, folded ℛ_def]
lemmas region_unique_spec = region_unique[of  X k, folded ℛ_def, simplified]
lemmas regions_closed'_spec = regions_closed'[of  X k, folded ℛ_def, simplified]

lemma valid_regions_distinct_spec:
  "R    R'    v  R  v  R'  R = R'"
unfolding ℛ_def using valid_regions_distinct
by auto (drule valid_regions_distinct, assumption+, simp)+

definition cla ("Closureα _" [71] 71)
where
  "cla Z =  {R  . R  Z  {}}"


subsubsection ‹The nice and easy properties proved by Bouyer›

lemma closure_constraint_id:
  "(x, m)collect_clock_pairs g. m  real (k x)  x  X  m    Closureα g = g  V"
proof goal_cases
  case 1
  show ?case
  proof auto
    fix v assume v: "v  Closureα g"
    then obtain R where R: "v  R" "R  " "R  g  {}" unfolding cla_def by auto
    with ccompatible[OF 1, folded ℛ_def] show "v  g" unfolding ccompatible_def by auto
    from R show "v  V" unfolding V_def ℛ_def by auto
  next
    fix v assume v: "v  g" "v  V"
    with region_cover[of X v k, folded ℛ_def] obtain R where "R  " "v  R" unfolding V_def by auto
    then show "v  Closureα g" unfolding cla_def using v by auto
  qed
qed

lemma closure_id':
  "Z  {}  Z  R  R    Closureα Z = R"
proof goal_cases
  case 1
  note A = this
  then have "R  Closureα Z" unfolding cla_def by auto
  moreover
  { fix R' assume R': "Z  R'  {}" "R'  " "R  R'"
    with A obtain v where "v  R" "v  R'" by auto
    with ℛ_regions_distinct[OF _ A(3) this(1) R'(2-)] ℛ_def have False by auto
  }
  ultimately show ?thesis unfolding cla_def by auto
qed

lemma closure_id:
  "Closureα Z  {}  Z  R  R    Closureα Z = R"
proof goal_cases
  case 1
  then have "Z  {}" unfolding cla_def by auto
  with 1 closure_id' show ?case by blast
qed

lemma closure_update_mono:
  "Z  V  set r  X  zone_set (Closureα Z) r  Closureα(zone_set Z r)"
proof -
  assume A: "Z  V" "set r  X"
  let ?U = "{R  . Z  R  {}}"
  from A(1) region_cover_spec  have " v  Z.  R. R    v  R" unfolding V_def by auto
  then have "Z =  {Z  R | R. R  ?U}"
  proof (auto, goal_cases)
    case (1 v)
    then obtain R where "R  " "v  R" by auto
    moreover with 1 have "Z  R  {}" "v  Z  R" by auto
    ultimately show ?case by auto
  qed
  then obtain U where U: "Z =  {Z  R | R. R  U}" " R  U. R  " by blast
  { fix R assume R: "R  U"
    { fix v' assume v': "v'  zone_set (Closureα (Z  R)) r - Closureα(zone_set (Z  R) r)"
      then obtain v where *:
        "v  Closureα (Z  R)" "v' = [r  0]v"
      unfolding zone_set_def by auto
      with closure_id[of "Z  R" R] R U(2) have **:
        "Closureα (Z  R) = R" "Closureα (Z  R)  "
      by fastforce+
      with region_set'_id[OF _ *(1) finite _ _ A(2), of k 0, folded ℛ_def, OF this(2)]
      have ***: "zone_set R r  " "[r0]v  zone_set R r"
      unfolding zone_set_def region_set'_def by auto
      from * have "Z  R  {}" unfolding cla_def by auto
      then have "zone_set (Z  R) r  {}" unfolding zone_set_def by auto
      from closure_id'[OF this _ ***(1)] have "Closureα zone_set (Z  R) r = zone_set R r"
      unfolding zone_set_def by auto
      with v' **(1) have False by auto
    }
    then have "zone_set (Closureα (Z  R)) r  Closureα(zone_set (Z  R) r)" by auto
  } note Z_i = this
  from U(1) have "Closureα Z =  {Closureα (Z  R) | R. R  U}" unfolding cla_def by auto
  then have "zone_set (Closureα Z) r =  {zone_set (Closureα (Z  R)) r | R. R  U}"
  unfolding zone_set_def by auto
  also have "   {Closureα(zone_set (Z  R) r) | R. R  U}" using Z_i by auto
  also have " = Closureα  {(zone_set (Z  R) r) | R. R  U}" unfolding cla_def by auto
  also have " = Closureα zone_set ( {Z  R| R. R  U}) r"
  proof goal_cases
    case 1
    have "zone_set ( {Z  R| R. R  U}) r =  {(zone_set (Z  R) r) | R. R  U}"
    unfolding zone_set_def by auto
    then show ?case by auto
  qed
  finally show "zone_set (Closureα Z) r  Closureα(zone_set Z r)" using U by simp
qed

lemma SuccI3:
  "R    v  R  t  0  (v  t)  R'  R'    R'  Succ  R"
 apply (intro SuccI2[of  X k, folded ℛ_def, simplified])
    apply assumption+
   apply (intro region_unique[of  X k, folded ℛ_def, simplified, symmetric])
by assumption+

lemma closure_delay_mono:
  "Z  V  (Closureα Z)  Closureα (Z)"
proof
  fix v assume v: "v  (Closureα Z)" and Z: "Z  V"
  then obtain u u' t R where A:
    "u  Closureα Z" "v = (u  t)" "u  R" "u'  R" "R  " "u'  Z" "t  0"
  unfolding cla_def zone_delay_def by blast
  from A(3,5) have " x  X. u x  0" unfolding ℛ_def by fastforce
  with region_cover_spec[of v] A(2,7) obtain R' where R':
    "R'  " "v  R'"
  unfolding cval_add_def by auto
  with set_of_regions_spec[OF A(5,4), OF SuccI3, of u] A obtain t where t:
    "t  0" "[u'  t]⇩ = R'"
  by auto
  with A have "(u'  t)  Z" unfolding zone_delay_def by auto
  moreover from regions_closed'_spec[OF A(5,4)] t have "(u'  t)  R'" by auto
  ultimately have "R'  (Z)  {}" by auto
  with R' show "v  Closureα (Z)" unfolding cla_def by auto
qed

lemma region_V: "R    R  V" using V_def ℛ_def region.cases by auto

lemma closure_V:
  "Closureα Z  V"
unfolding cla_def using region_V by auto

lemma closure_V_int:
  "Closureα Z = Closureα (Z  V)"
unfolding cla_def using region_V by auto

lemma closure_constraint_mono:
  "Closureα g = g  g  (Closureα Z)  Closureα (g  Z)"
unfolding cla_def by auto

lemma closure_constraint_mono':
  assumes "Closureα g = g  V"
  shows "g  (Closureα Z)  Closureα (g  Z)"
proof -
  from assms closure_V_int have "Closureα (g  V) = g  V" by auto
  from closure_constraint_mono[OF this, of Z] have
    "g  (V  Closureα Z)  Closureα (g  Z  V)"
  by (metis Int_assoc Int_commute)
  with closure_V[of Z] closure_V_int[of "g  Z"] show ?thesis by auto
qed

lemma cla_empty_iff:
  "Z  V  Z = {}  Closureα Z = {}"
unfolding cla_def V_def using region_cover_spec by fast

lemma closure_involutive_aux:
  "U    Closureα  U =  U"
unfolding cla_def using valid_regions_distinct_spec by blast

lemma closure_involutive_aux':
  " U. U    Closureα Z =  U"
unfolding cla_def by (rule exI[where x = "{R  . R  Z  {}}"]) auto

lemma closure_involutive:
  "Closureα Closureα Z = Closureα Z"
using closure_involutive_aux closure_involutive_aux' by metis

lemma closure_involutive':
  "Z  Closureα W  Closureα Z  Closureα W"
unfolding cla_def using valid_regions_distinct_spec by fast

lemma closure_subs:
  "Z  V  Z  Closureα Z"
unfolding cla_def V_def using region_cover_spec by fast

lemma cla_mono':
  "Z'  V  Z  Z'  Closureα Z  Closureα Z'"
by (meson closure_involutive' closure_subs subset_trans)

lemma cla_mono:
  "Z  Z'  Closureα Z  Closureα Z'"
using closure_V_int cla_mono'[of "Z'  V" "Z  V"] by auto


section ‹A New Zone Semantics Abstracting with Closureα

subsection ‹Single step›

inductive step_z_alpha ::
  "('a, 'c, t, 's) ta  's  ('c, t) zone  's  ('c, t) zone  bool"
("_  _, _ α _, _" [61,61,61] 61)
where
  step_alpha: "A  l, Z  l', Z'  A  l, Z α l', Closureα Z'"

inductive_cases[elim!]: "A  l, u α l',u'"

declare step_z_alpha.intros[intro]

lemma up_V: "Z  V  Z  V"
unfolding V_def zone_delay_def cval_add_def by auto

lemma reset_V: "Z  V  (zone_set Z r)  V"
unfolding V_def unfolding zone_set_def by (induction r, auto)

lemma step_z_V: "A  l, Z  l',Z'  Z  V  Z'  V"
 apply (induction rule: step_z.induct)
  apply (rule le_infI1)
  apply (rule up_V)
  apply blast
 apply (rule le_infI1)
 apply (rule reset_V)
by blast


text ‹Single-step soundness and completeness follows trivially from cla_empty_iff›.›

lemma step_z_alpha_sound:
  "A  l, Z α l',Z'  Z  V  Z'  {}   Z''. A  l, Z  l',Z''  Z''  {}"
 apply (induction rule: step_z_alpha.induct)
  apply (frule step_z_V)
  apply assumption
 apply (rotate_tac 3)
 apply (drule cla_empty_iff)
by auto

lemma step_z_alpha_complete:
  "A  l, Z  l',Z'  Z  V  Z'  {}   Z''. A  l, Z α l',Z''  Z''  {}"
 apply (frule step_z_V)
  apply assumption
 apply (rotate_tac 3)
 apply (drule cla_empty_iff)
by auto

lemma zone_set_mono:
  "A  B  zone_set A r  zone_set B r"
unfolding zone_set_def by auto

lemma zone_delay_mono:
  "A  B  A  B"
unfolding zone_delay_def by auto


subsection ‹Multi step›

inductive
  steps_z_alpha :: "('a, 'c, t, 's) ta  's  ('c, t) zone  's  ('c, t) zone  bool"
("_  _, _ α* _, _" [61,61,61] 61)
where
  refl: "A  l, Z α* l, Z" |
  step: "A  l, Z α* l', Z'  A  l', Z' α l'', Z''  A  l, Z α* l'', Z''"

declare steps_z_alpha.intros[intro]

lemma subset_int_mono: "A  B  A  C  B  C" by blast

text ‹P. Bouyer's calculation for @{term "Post(Closureα Z, e)  Closureα(Post (Z, e))"}
text ‹This is now obsolete as we argue solely with monotonicty of steps_z› w.r.t Closureα

lemma calc:
  "valid_abstraction A X k  Z  V  A  l, Closureα Z  l', Z'
   Z''. A  l, Z α l', Z''  Z'  Z''"
proof (cases rule: step_z.cases, assumption, goal_cases)
  case 1
  note A = this
  from A(1) have "(x, m)clkp_set A. m  real (k x)  x  X  m  "
  by (fastforce elim: valid_abstraction.cases)
  then have "(x, m)collect_clock_pairs (inv_of A l). m  real (k x)  x  X  m  "
  unfolding clkp_set_def collect_clki_def inv_of_def by auto
  from closure_constraint_id[OF this] have *: "Closureα inv_of A l = inv_of A l  V" .
  from closure_constraint_mono'[OF *, of Z] have
    "(Closureα Z)  {u. u  inv_of A l}  Closureα (Z  {u. u  inv_of A l})"
  unfolding ccval_def by (subst Int_commute) (subst (asm) (2) Int_commute, assumption)
  moreover have "  Closureα ((Z  {u. u  inv_of A l}))" using A(2) by (blast intro!: closure_delay_mono)
  ultimately have "Z'  Closureα ((Z  {u. u  inv_of A l})  {u. u  inv_of A l})"
  using closure_constraint_mono'[OF *, of "(Z  {u. u  inv_of A l})"] unfolding ccval_def
   apply (subst A(5))
   apply (subst (asm) (5 7) Int_commute)
   apply (rule subset_trans)
    defer
    apply assumption
   apply (subst subset_int_mono)
    defer
    apply rule
   apply (rule subset_trans)
    defer
    apply assumption
   apply (rule zone_delay_mono)
   apply assumption
  done
  with A(4,3) show ?thesis by auto
next
  case (2 g a r)
  note A = this
  from A(1) have *:
    "(x, m)clkp_set A. m  real (k x)  x  X  m  "
    "collect_clkvt (trans_of A)  X"
    "finite X"
  by (auto elim: valid_abstraction.cases)
  from *(1) A(5) have "(x, m)collect_clock_pairs (inv_of A l'). m  real (k x)  x  X  m  "
  unfolding clkp_set_def collect_clki_def inv_of_def by fastforce
  from closure_constraint_id[OF this] have **: "Closureα inv_of A l' = inv_of A l'  V" .
  from *(1) A(5) have "(x, m)collect_clock_pairs g. m  real (k x)  x  X  m  "
  unfolding clkp_set_def collect_clkt_def by fastforce
  from closure_constraint_id[OF this] have ***: "Closureα g = g  V" .
  from *(2) A(5) have ****: "set r  X" unfolding collect_clkvt_def by fastforce
  from closure_constraint_mono'[OF ***, of Z] have
    "(Closureα Z)  {u. u  g}  Closureα (Z  {u. u  g})" unfolding ccval_def
  by (subst Int_commute) (subst (asm) (2) Int_commute, assumption)
  moreover have "zone_set  r  Closureα (zone_set (Z  {u. u  g}) r)" using **** A(2)
  by (intro closure_update_mono, auto)
  ultimately have "Z'  Closureα (zone_set (Z  {u. u  g}) r  {u. u  inv_of A l'})"
  using closure_constraint_mono'[OF **, of "zone_set (Z  {u. u  g}) r"] unfolding ccval_def
    apply (subst A(4))
    apply (subst (asm) (5 7) Int_commute)
    apply (rule subset_trans)
     defer
     apply assumption
    apply (subst subset_int_mono)
     defer
     apply rule
    apply (rule subset_trans)
     defer
     apply assumption
    apply (rule zone_set_mono)
    apply assumption
  done
  with A(5) show ?thesis by auto
qed


text ‹
  Turning P. Bouyers argument for multiple steps into an inductive proof is not direct.
  With this initial argument we can get to a point where the induction hypothesis is applicable.
  This breaks the "information hiding" induced by the different variants of steps.
›

lemma steps_z_alpha_closure_involutive'_aux:
  "A  l, Z  l',Z'  Closureα Z  Closureα W  valid_abstraction A X k  Z  V
    W'. A  l, W  l',W'  Closureα Z'  Closureα W'"
proof (induction rule: step_z.induct)
  case A: (step_t_z A l Z)
  let ?Z' = "(Z  {u. u  inv_of A l})  {u. u  inv_of A l}"
  let ?W' = "(W  {u. u  inv_of A l})  {u. u  inv_of A l}"
  from ℛ_def have ℛ_def': " = {region X I r |I r. valid_region X k I r}" by simp
  have step_z: "A  l, W  l,?W'" by auto
  moreover have "Closureα ?Z'  Closureα ?W'"
  proof
    fix v assume v: "v  Closureα ?Z'"
    then obtain R' v' where 1: "R'  " "v  R'" "v'  R'" "v'  ?Z'" unfolding cla_def by auto
    then obtain u d where
      "u  Z" and v': "v' = u  d" "u  inv_of A l" "u  d  inv_of A l" "0  d"
    unfolding zone_delay_def by blast
    with closure_subs[OF A(3)] A(1) obtain u' R where u': "u'  W" "u  R" "u'  R" "R  "
    unfolding cla_def by blast
    then have "xX. 0  u x" unfolding ℛ_def by fastforce
    from region_cover'[OF ℛ_def' this] have R: "[u]⇩  " "u  [u]⇩" by auto
    from SuccI2[OF ℛ_def' this(2,1) v'(4), of "[v']⇩"] v'(1) have v'1:
      "[v']⇩  Succ  ([u]⇩)" "[v']⇩  "
    by auto
    from regions_closed'_spec[OF R(1,2) v'(4)] v'(1) have v'2: "v'  [v']⇩" by simp
    from A(2) have *:
      "(x, m)clkp_set A. m  real (k x)  x  X  m  "
      "collect_clkvt (trans_of A)  X"
      "finite X"
    by (auto elim: valid_abstraction.cases)
    from *(1) u'(2) have "(x, m)collect_clock_pairs (inv_of A l). m  real (k x)  x  X  m  "
    unfolding clkp_set_def collect_clki_def inv_of_def by fastforce
    from ccompatible[OF this, folded ℛ_def'] v'1(2) v'2 v'(1,2,3) R have 3:
      "[v']⇩  inv_of A l" "([u]⇩)  inv_of A l"
    unfolding ccompatible_def ccval_def by auto
    with A v'1 R(1) ℛ_def' have "A,  l, ([u]⇩)  l,([v']⇩)" by auto
    with valid_regions_distinct_spec[OF v'1(2) 1(1) v'2 1(3)] region_unique_spec[OF u'(2,4)]
    have step_r: "A,  l, R  l, R'" and 2: "[v']⇩ = R'" "[u]⇩ = R" by auto
    from set_of_regions_spec[OF u'(4,3)] v'1(1) 2 obtain t where t: "t  0" "[u'  t]⇩ = R'" by auto
    with regions_closed'_spec[OF u'(4,3) this(1)] step_t_r(1) have *: "u'  t  R'" by auto
    with t(1) 3 2 u'(1,3) have "A  l, u'  l, u'  t" "u'  t  ?W'"
    unfolding zone_delay_def ccval_def by auto
    with * 1(1) have "R'  Closureα ?W'" unfolding cla_def by auto
    with 1(2) show "v  Closureα ?W'" ..
  qed
  ultimately show ?case by auto
next
  case A: (step_a_z A l g a r l' Z)
  let ?Z' = "zone_set (Z  {u. u  g}) r  {u. u  inv_of A l'}"
  let ?W' = "zone_set (W  {u. u  g}) r  {u. u  inv_of A l'}"
  from ℛ_def have ℛ_def': " = {region X I r |I r. valid_region X k I r}" by simp
  from A(1) have step_z: "A  l, W  l',?W'" by auto
  moreover have "Closureα ?Z'  Closureα ?W'"
  proof
    fix v assume v: "v  Closureα ?Z'"
    then obtain R' v' where 1: "R'  " "v  R'" "v'  R'" "v'  ?Z'" unfolding cla_def by auto
    then obtain u where
      "u  Z" and v': "v' = [r0]u" "u  g" "v'  inv_of A l'"
    unfolding zone_set_def by blast
    let ?R'= "region_set' (([u]⇩)  {u. u  g}) r 0  {u. u  inv_of A l'}"
    from u  Z closure_subs[OF A(4)] A(2) obtain u' R where u': "u'  W" "u  R" "u'  R" "R  "
    unfolding cla_def by blast
    then have "xX. 0  u x" unfolding ℛ_def by fastforce
    from region_cover'[OF ℛ_def' this] have R: "[u]⇩  " "u  [u]⇩" by auto
    from step_r_complete_aux[OF ℛ_def' A(3) this(2,1) A(1) v'(2)] v'
    have *: "[u]⇩ = ([u]⇩)  {u. u  g}" "?R' = region_set' ([u]⇩) r 0" "?R'  " by auto
    from ℛ_def' A(3) have "collect_clkvt (trans_of A)  X" "finite X"
    by (auto elim: valid_abstraction.cases)
    with A(1) have r: "set r  X" unfolding collect_clkvt_def by fastforce
    from * v'(1) R(2) have "v'  ?R'" unfolding region_set'_def by auto
    moreover have "A,  l,([u]⇩)  l',?R'" using R(1) ℛ_def' A(1,3) v'(2) by auto
    thm valid_regions_distinct_spec
    with valid_regions_distinct_spec[OF *(3) 1(1) v'  ?R' 1(3)] region_unique_spec[OF u'(2,4)]
    have 2: "?R' = R'" "[u]⇩ = R" by auto
    with * u' have *: "[r0]u'  ?R'" "u'  g" "[r0]u'  inv_of A l'"
    unfolding region_set'_def by auto
    with A(1) have "A  l, u'  l',[r0]u'" apply (intro step.intros(1)) apply rule by auto
    moreover from * u'(1) have "[r0]u'  ?W'" unfolding zone_set_def by auto
    ultimately have "R'  Closureα ?W'" using *(1) 1(1) 2(1) unfolding cla_def by auto
    with 1(2) show "v  Closureα ?W'" ..
  qed
  ultimately show ?case by meson
qed

lemma steps_z_alpha_closure_involutive'_aux':
  "A  l, Z  l',Z'  Closureα Z  Closureα W  valid_abstraction A X k  Z  V  W  Z
    W'. A  l, W  l',W'  Closureα Z'  Closureα W'  W'  Z'"
proof (induction rule: step_z.induct)
  case A: (step_t_z A l Z)
  let ?Z' = "(Z  {u. u  inv_of A l})  {u. u  inv_of A l}"
  let ?W' = "(W  {u. u  inv_of A l})  {u. u  inv_of A l}"
  from ℛ_def have ℛ_def': " = {region X I r |I r. valid_region X k I r}" by simp
  have step_z: "A  l, W  l,?W'" by auto
  moreover have "Closureα ?Z'  Closureα ?W'"
  proof
    fix v assume v: "v  Closureα ?Z'"
    then obtain R' v' where 1: "R'  " "v  R'" "v'  R'" "v'  ?Z'" unfolding cla_def by auto
    then obtain u d where
      "u  Z" and v': "v' = u  d" "u  inv_of A l" "u  d  inv_of A l" "0  d"
    unfolding zone_delay_def by blast
    with closure_subs[OF A(3)] A(1) obtain u' R where u': "u'  W" "u  R" "u'  R" "R  "
    unfolding cla_def by blast
    then have "xX. 0  u x" unfolding ℛ_def by fastforce
    from region_cover'[OF ℛ_def' this] have R: "[u]⇩  " "u  [u]⇩" by auto
    from SuccI2[OF ℛ_def' this(2,1) v'(4), of "[v']⇩"] v'(1) have v'1:
      "[v']⇩  Succ  ([u]⇩)" "[v']⇩  "
    by auto
    from regions_closed'_spec[OF R(1,2) v'(4)] v'(1) have v'2: "v'  [v']⇩" by simp
    from A(2) have *:
      "(x, m)clkp_set A. m  real (k x)  x  X  m  "
      "collect_clkvt (trans_of A)  X"
      "finite X"
    by (auto elim: valid_abstraction.cases)
    from *(1) u'(2) have "(x, m)collect_clock_pairs (inv_of A l). m  real (k x)  x  X  m  "
    unfolding clkp_set_def collect_clki_def inv_of_def by fastforce
    from ccompatible[OF this, folded ℛ_def'] v'1(2) v'2 v'(1,2,3) R have 3:
      "[v']⇩  inv_of A l" "([u]⇩)  inv_of A l"
    unfolding ccompatible_def ccval_def by auto
    with A v'1 R(1) ℛ_def' have "A,  l, ([u]⇩)  l,([v']⇩)" by auto
    with valid_regions_distinct_spec[OF v'1(2) 1(1) v'2 1(3)] region_unique_spec[OF u'(2,4)]
    have step_r: "A,  l, R  l, R'" and 2: "[v']⇩ = R'" "[u]⇩ = R" by auto
    from set_of_regions_spec[OF u'(4,3)] v'1(1) 2 obtain t where t: "t  0" "[u'  t]⇩ = R'" by auto
    with regions_closed'_spec[OF u'(4,3) this(1)] step_t_r(1) have *: "u'  t  R'" by auto
    with t(1) 3 2 u'(1,3) have "A  l, u'  l, u'  t" "u'  t  ?W'"
    unfolding zone_delay_def ccval_def by auto
    with * 1(1) have "R'  Closureα ?W'" unfolding cla_def by auto
    with 1(2) show "v  Closureα ?W'" ..
  qed
  moreover have "?W'  ?Z'" using W  Z unfolding zone_delay_def by auto
  ultimately show ?case by auto
next
  case A: (step_a_z A l g a r l' Z)
  let ?Z' = "zone_set (Z  {u. u  g}) r  {u. u  inv_of A l'}"
  let ?W' = "zone_set (W  {u. u  g}) r  {u. u  inv_of A l'}"
  from ℛ_def have ℛ_def': " = {region X I r |I r. valid_region X k I r}" by simp
  from A(1) have step_z: "A  l, W  l',?W'" by auto
  moreover have "Closureα ?Z'  Closureα ?W'"
  proof
    fix v assume v: "v  Closureα ?Z'"
    then obtain R' v' where 1: "R'  " "v  R'" "v'  R'" "v'  ?Z'" unfolding cla_def by auto
    then obtain u where
      "u  Z" and v': "v' = [r0]u" "u  g" "v'  inv_of A l'"
    unfolding zone_set_def by blast
    let ?R'= "region_set' (([u]⇩)  {u. u  g}) r 0  {u. u  inv_of A l'}"
    from u  Z closure_subs[OF A(4)] A(2) obtain u' R where u': "u'  W" "u  R" "u'  R" "R  "
    unfolding cla_def by blast
    then have "xX. 0  u x" unfolding ℛ_def by fastforce
    from region_cover'[OF ℛ_def' this] have R: "[u]⇩  " "u  [u]⇩" by auto
    from step_r_complete_aux[OF ℛ_def' A(3) this(2,1) A(1) v'(2)] v'
    have *: "[u]⇩ = ([u]⇩)  {u. u  g}" "?R' = region_set' ([u]⇩) r 0" "?R'  " by auto
    from ℛ_def' A(3) have "collect_clkvt (trans_of A)  X" "finite X"
    by (auto elim: valid_abstraction.cases)
    with A(1) have r: "set r  X" unfolding collect_clkvt_def by fastforce
    from * v'(1) R(2) have "v'  ?R'" unfolding region_set'_def by auto
    moreover have "A,  l,([u]⇩)  l',?R'" using R(1) ℛ_def' A(1,3) v'(2) by auto
    thm valid_regions_distinct_spec
    with valid_regions_distinct_spec[OF *(3) 1(1) v'  ?R' 1(3)] region_unique_spec[OF u'(2,4)]
    have 2: "?R' = R'" "[u]⇩ = R" by auto
    with * u' have *: "[r0]u'  ?R'" "u'  g" "[r0]u'  inv_of A l'"
    unfolding region_set'_def by auto
    with A(1) have "A  l, u'  l',[r0]u'" apply (intro step.intros(1)) apply rule by auto
    moreover from * u'(1) have "[r0]u'  ?W'" unfolding zone_set_def by auto
    ultimately have "R'  Closureα ?W'" using *(1) 1(1) 2(1) unfolding cla_def by auto
    with 1(2) show "v  Closureα ?W'" ..
  qed
  moreover have "?W'  ?Z'" using W  Z unfolding zone_set_def by auto
  ultimately show ?case by meson
qed

lemma steps_z_alt:
  "A  l, Z ↝* l',Z'  A  l', Z'  l'',Z''  A  l, Z ↝* l'',Z''"
by (induction rule: steps_z.induct) auto

lemma steps_z_alpha_V: "A  l, Z α* l',Z'  Z  V  Z'  V"
apply (induction rule: steps_z_alpha.induct) using closure_V by auto

lemma steps_z_alpha_closure_involutive':
  "A  l, Z α* l',Z'  A  l', Z'  l'',Z''  valid_abstraction A X k  Z  V
    Z'''. A  l, Z ↝* l'',Z'''  Closureα Z''  Closureα Z'''  Z'''  Z''"
proof (induction A l Z l' Z' arbitrary: Z'' l'' rule: steps_z_alpha.induct, goal_cases)
  case refl from this(1) show ?case by blast
next
  case A: (2 A l Z l' Z' l'' Z'' Z''a l''a)
  from A(3) obtain 𝒵 where Z'': "Z'' = Closureα 𝒵" "A  l', Z'  l'',𝒵" by auto
  from A(2)[OF Z''(2) A(5,6)] obtain Z''' where Z''':
    "A  l, Z ↝* l'',Z'''" "Closureα 𝒵  Closureα Z'''" "Z'''  𝒵"
  by auto
  from closure_subs have *:
    "Z'''  Closureα 𝒵"
  by (metis A(1,6) Z'''(3) Z''(2) step_z_V steps_z_alpha_V subset_trans) 
  from A(4) Z'' have "A  l'', Closureα 𝒵  l''a,Z''a" by auto
  from steps_z_alpha_closure_involutive'_aux'[OF this(1) _ A(5) closure_V *] Z'''(2,3) obtain W'
    where ***: "A  l'', Z'''  l''a,W'" "Closureα Z''a  Closureα W'" "W'  Z''a"
  by (auto simp: closure_involutive)
  with Z'''(1) have "A  l, Z ↝* l''a,W'" by (blast intro: steps_z_alt)
  with ***(2,3) show ?case by blast
qed

text ‹Old proof using Bouyer's calculation›
lemma steps_z_alpha_closure_involutive'':
  "A  l, Z α* l',Z'  A  l', Z'  l'',Z''  valid_abstraction A X k  Z  V
    Z'''. A  l, Z ↝* l'',Z'''  Closureα Z''  Closureα Z'''"
proof (induction A l Z l' Z' arbitrary: Z'' l'' rule: steps_z_alpha.induct, goal_cases)
  case refl from this(1) show ?case by blast
next
  case A: (2 A l Z l' Z' l'' Z'' Z''a l''a)
  from A(3) obtain 𝒵 where Z'': "Z'' = Closureα 𝒵" "A  l', Z'  l'',𝒵" by auto
  from A(2)[OF Z''(2) A(5,6)] obtain Z''' where Z''':
    "A  l, Z ↝* l'',Z'''" "Closureα 𝒵  Closureα Z'''"
  by auto
  from steps_z_alpha_V[OF A(1,6)] step_z_V[OF Z''(2)] have *: "𝒵  V" by blast
  from A Z'' have "A  l'', Closureα 𝒵  l''a,Z''a" by auto
  from calc[OF A(5) * this] obtain 𝒵' where **:
    "A  l'', 𝒵  l''a,𝒵'" "Z''a  Closureα 𝒵'"
  by auto
  from steps_z_alpha_closure_involutive'_aux[OF this(1) Z'''(2) A(5) *] obtain W' where ***:
    "A  l'', Z'''  l''a,W'" "Closureα 𝒵'  Closureα W'"
  by auto
  with Z'''(1) have "A  l, Z ↝* l''a,W'" by (blast intro: steps_z_alt)
  with closure_involutive'[OF **(2)] ***(2) show ?case by blast
qed

lemma steps_z_alpha_closure_involutive:
  "A  l, Z α* l',Z'  valid_abstraction A X k  Z  V
    Z''. A  l, Z ↝* l',Z''  Closureα Z'  Closureα Z''  Z''  Z'"
proof (induction A l Z l' Z' rule: steps_z_alpha.induct)
  case refl show ?case by blast
next
  case 2: (step A l Z l' Z' l'' Z'')
  then obtain Z''a where *: "A  l', Z'  l'',Z''a" "Z'' = Closureα Z''a" by auto
  from steps_z_alpha_closure_involutive'[OF 2(1) this(1) 2(4,5)] obtain Z''' where Z''':
    "A  l, Z ↝* l'',Z'''" "Closureα Z''a  Closureα Z'''" "Z'''  Z''a" by blast
  have "Z'''  Z''" by (metis *(1,2) 2(1,5) Z'''(3) closure_subs step_z_V steps_z_alpha_V subset_trans) 
  with * closure_involutive Z''' show ?case by auto
qed

lemma steps_z_V:
  "A  l, Z ↝* l',Z'  Z  V  Z'  V"
apply (induction rule: steps_z.induct)
  apply blast
using step_z_V by metis

lemma steps_z_alpha_sound:
  "A  l, Z α* l',Z'  valid_abstraction A X k  Z  V  Z'  {}
    Z''. A  l, Z ↝* l',Z''  Z''  {}  Z''  Z'"
proof goal_cases
  case 1
  from steps_z_alpha_closure_involutive[OF 1(1-3)] obtain Z'' where
    Z'': "A  l, Z ↝* l',Z''" "Closureα Z'  Closureα Z''" "Z''  Z'"
    by blast
  with 1(4) cla_empty_iff[OF steps_z_alpha_V[OF 1(1)], OF 1(3)]
    cla_empty_iff[OF steps_z_V, OF this(1) 1(3)] have "Z''  {}" by auto
  with Z'' show ?case by auto
qed

lemma step_z_mono:
  "A  l, Z  l',Z'  Z  W   W'. A  l, W  l',W'  Z'  W'"
proof (cases rule: step_z.cases, assumption, goal_cases)
  case A: 1
  let ?W' = "(W  {u. u  inv_of A l})  {u. u  inv_of A l}"
  from A have "A  l, W  l',?W'" by auto
  moreover have "Z'  ?W'"
    apply (subst A(4))
    apply (rule subset_int_mono)
    apply (rule zone_delay_mono)
    apply (rule subset_int_mono)
    apply (rule A(2))
  done
  ultimately show ?thesis by auto
next
  case A: (2 g a r)
  let ?W' = "zone_set (W  {u. u  g}) r  {u. u  inv_of A l'}"
  from A have "A  l, W  l',?W'" by auto
  moreover have "Z'  ?W'"
    apply (subst A(3))
    apply (rule subset_int_mono)
    apply (rule zone_set_mono)
    apply (rule subset_int_mono)
    apply (rule A(2))
  done
  ultimately show ?thesis by auto
qed

lemma step_z_alpha_mono:
  "A  l, Z α l',Z'  Z  W  W  V   W'. A  l, W α l',W'  Z'  W'"
proof goal_cases
  case 1
  then obtain Z'' where *: "A  l, Z  l',Z''" "Z' = Closureα Z''" by auto
  from step_z_mono[OF this(1) 1(2)] obtain W' where "A  l, W  l',W'" "Z''  W'" by auto
  moreover with *(2) have "Z'  Closureα W'" unfolding cla_def by auto
  ultimately show ?case by blast
qed

lemma steps_z_alpha_mono:
  "A  l, Z α* l',Z'  Z  W  W  V   W'. A  l, W α* l',W'  Z'  W'"
proof (induction rule: steps_z_alpha.induct, goal_cases)
  case refl then show ?case by auto
next
  case (2 A l Z l' Z' l'' Z'')
  then obtain W' where "A  l, W α* l',W'" "Z'  W'" by auto
  with step_z_alpha_mono[OF 2(3) this(2) steps_z_alpha_V[OF this(1) 2(5)]]
  show ?case by blast
qed

lemma steps_z_alpha_alt:
  "A  l, Z α l', Z'  A  l', Z' α* l'', Z''  A  l, Z α* l'', Z''"
by (rotate_tac, induction rule: steps_z_alpha.induct) blast+

lemma steps_z_alpha_complete:
  "A  l, Z ↝* l',Z'  valid_abstraction A X k  Z  V  Z'  {}
    Z''. A  l, Z α* l',Z''  Z'  Z''"
proof (induction rule: steps_z.induct, goal_cases)
  case refl with cla_empty_iff show ?case by blast
next
  case (2 A l Z l' Z' l'' Z'')
  with step_z_V[OF this(1,5)] obtain Z''' where "A  l', Z' α* l'',Z'''" "Z''  Z'''" by blast
  with steps_z_alpha_mono[OF this(1) closure_subs[OF step_z_V[OF 2(1,5)]] closure_V]
  obtain W' where "A  l', Closureα Z' α* l'',W'" " Z''  W'" by auto
  moreover with 2(1) have "A  l, Z α* l'',W'" by (auto intro: steps_z_alpha_alt)
  ultimately show ?case by auto
qed

lemma steps_z_alpha_complete':
  "A  l, Z ↝* l',Z'  valid_abstraction A X k  Z  V  Z'  {}
    Z''. A  l, Z α* l',Z''  Z''  {}"
using steps_z_alpha_complete by fast

end

end

Theory Approx_Beta

theory Approx_Beta
  imports DBM_Zone_Semantics Regions_Beta Closure
begin

chapter ‹Correctness of β›-approximation from α›-regions›

text ‹Instantiating real›

instantiation real :: linordered_ab_monoid_add
begin

definition
  neutral_real: "𝟭 = (0 :: real)"

instance by standard (auto simp: neutral_real)

end

text ‹Merging the locales for the two types of regions›

locale Regions =
  fixes X and k :: "'c  nat" and v :: "'c  nat" and n :: nat and not_in_X
  assumes finite: "finite X"
  assumes clock_numbering: "clock_numbering' v n" "kn. k > 0  (c  X. v c = k)"
                           " c  X. v c  n"
  assumes not_in_X: "not_in_X  X"
  assumes non_empty: "X  {}"
begin

definition ℛ_def:  "  {Regions.region X I r | I r. Regions.valid_region X k I r}"
definitionβ_def: "β  {Regions_Beta.region X I J r | I J r. Regions_Beta.valid_region X k I J r}"
definition V_def:  "V  {v .  x  X. v x  0}"

sublocale alpha_interp: AlphaClosure X k  V by (unfold_locales) (auto simp: finite ℛ_def V_def)

sublocale beta_interp: Beta_Regions' X k β V v n not_in_X
using finite non_empty clock_numbering not_in_X by (unfold_locales) (auto simp:β_def V_def)

abbreviation "Approxβ  beta_interp.Approxβ"

section ‹Preparing Bouyer's Theorem›

lemma region_dbm:
  assumes "R  ℛ"
  defines "v'  λ i. THE c. c  X  v c = i"
  obtains M
  where"[M]v,n = R"
  and " i  n.  j  n. M i 0 =   j > 0  i  j M i j =   M j i = "
  and " i  n. M i i = Le 0"
  and " i  n.  j  n. i > 0  j > 0  M i 0    M j 0    ( d :: int.
        (- k (v' j)  d  d  k (v' i)  M i j = Le d  M j i = Le (-d))
       (- k (v' j)  d - 1  d  k (v' i)  M i j = Lt d  M j i = Lt (-d + 1)))"
  and " i  n. i > 0  M i 0   
        ( d :: int. d  k (v' i)  d  0
           (M i 0 = Le d  M 0 i = Le (-d)  M i 0 = Lt d  M 0 i = Lt (-d + 1)))"
  and " i  n. i > 0  ( d :: int. - k (v' i)  d  d  0  (M 0 i = Le d  M 0 i = Lt d))"
  and " i.  j. M i j    get_const (M i j)  "
  and " i  n.  j  n. M i j    i > 0  j > 0 
      ( d:: int. (M i j = Le d  M i j = Lt d)  (- k (v' j))  d  d  k (v' i))"
proof -
  from assms obtain I r where R: "R = region X I r" "valid_region X k I r" unfolding ℛ_def by blast
  let ?X0 = "{x  X. d. I x = Regions.intv.Intv d}"
  define f where "f x = (if isIntv (I x) then Lt (intv_const (I x) + 1)
                 else if isConst (I x) then Le (intv_const (I x))
                 else )" for x
  define g where "g x = (if isIntv (I x) then Lt (- intv_const (I x))
                 else if isConst (I x) then Le (- intv_const (I x))
                 else Lt (- k x))" for x
  define h where "h x y = (if isIntv (I x)  isIntv (I y) then
                      if (y, x)  r  (x, y)  r then Lt (int (intv_const (I x)) - intv_const (I y) + 1)
                      else if (x, y)  r  (y, x)  r then Lt (int (intv_const (I x)) - intv_const (I y))
                      else Le (int (intv_const (I x)) - intv_const (I y))
                   else if isConst (I x)  isConst (I y) then Le (int (intv_const (I x)) - intv_const (I y))
                   else if isIntv (I x)  isConst (I y) then Lt (int (intv_const (I x)) + 1 - intv_const (I y))
                   else if isConst (I x)  isIntv (I y) then Lt (int (intv_const (I x)) - intv_const (I y))
                   else )" for x y
  let ?M = "λ i j. if i = 0 then if j = 0 then Le 0 else g (v' j)
                   else if j = 0 then f (v' i) else if i = j then Le 0 else h (v' i) (v' j)"
  have "[?M]v,n  R"
  proof
    fix u assume u: "u  [?M]v,n"
    show "u  R" unfolding R
    proof (standard, goal_cases)
      case 1
      show ?case
      proof
        fix c assume c: "c  X"
        with clock_numbering have c2: "v c  n" "v c > 0" "v' (v c) = c" unfolding v'_def by auto
        with u have "dbm_entry_val u None (Some c) (g c)"
        unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
        then show "0  u c" by (cases "isIntv (I c)"; cases "isConst (I c)") (auto simp: g_def)
      qed
    next
      case 2
      show ?case
      proof
        fix c assume c: "c  X"
        with clock_numbering have c2: "v c  n" "v c > 0" "v' (v c) = c" unfolding v'_def by auto
        with u have *: "dbm_entry_val u None (Some c) (g c)" "dbm_entry_val u (Some c) None (f c)"
        unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
        show "intv_elem c u (I c)"
        proof (cases "I c")
          case (Const d)
          then have "¬ isIntv (I c)" "isConst (I c)" by auto
          with * Const show ?thesis unfolding g_def f_def using Const by auto
        next
          case (Intv d)
          then have "isIntv (I c)" "¬ isConst (I c)" by auto
          with * Intv show ?thesis unfolding g_def f_def by auto
        next
          case (Greater d)
          then have "¬ isIntv (I c)" "¬ isConst (I c)" by auto
          with * Greater R(2) c show ?thesis unfolding g_def f_def by fastforce
        qed
      qed
    next
      show "?X0 = ?X0" ..
      show "x  ?X0.  y  ?X0. (x, y)  r  frac (u x)  frac (u y)"
      proof (standard, standard)
        fix x y assume A: "x  ?X0" "y  ?X0"
        show "(x, y)  r  frac (u x)  frac (u y)"
        proof (cases "x = y")
          case True
          have "refl_on ?X0 r" using R(2) by auto
          with A True show ?thesis unfolding refl_on_def by auto
        next
          case False
          from A obtain d d' where AA:
            "I x = Intv d" "I y = Intv d'" "isIntv (I x)" "isIntv (I y)" "¬ isConst (I x)" "¬ isConst (I y)"
          by auto
          from A False clock_numbering have B:
            "v x  n" "v x > 0" "v' (v x) = x" "v y  n" "v y > 0" "v' (v y) = y" "v x  v y"
          unfolding v'_def by auto
          with u have *: 
            "dbm_entry_val u (Some x) (Some y) (h x y)" "dbm_entry_val u (Some y) (Some x) (h y x)"
            "dbm_entry_val u None (Some x) (g x)" "dbm_entry_val u (Some x) None (f x)"
            "dbm_entry_val u None (Some y) (g y)" "dbm_entry_val u (Some y) None (f y)"
          unfolding DBM_zone_repr_def DBM_val_bounded_def by force+
          show "(x, y)  r  frac (u x)  frac (u y)"
          proof
            assume C: "(x, y)  r"
            show "frac (u x)  frac (u y)"
            proof (cases "(y, x)  r")
              case False
              with * AA C have **:
                "u x - u y < int d - d'"
                "d < u x" "u x < d + 1" "d' < u y" "u y < d' + 1"
              unfolding f_def g_def h_def by auto
              from nat_intv_frac_decomp[OF **(2,3)] nat_intv_frac_decomp[OF **(4,5)] **(1) show
                "frac (u x)  frac (u y)"
              by simp
            next
              case True
              with * AA C have **:
                "u x - u y  int d - d'"
                "d < u x" "u x < d + 1" "d' < u y" "u y < d' + 1"
              unfolding f_def g_def h_def by auto
              from nat_intv_frac_decomp[OF **(2,3)] nat_intv_frac_decomp[OF **(4,5)] **(1) show
                "frac (u x)  frac (u y)"
              by simp
            qed
          next
            assume "frac (u x)  frac (u y)"
            show "(x, y)  r"
            proof (rule ccontr)
              assume C: "(x,y)  r"
              moreover from R(2) have "total_on ?X0 r" by auto
              ultimately have "(y, x)  r" using False A unfolding total_on_def by auto
              with *(2-) AA C have **:
                "u y - u x < int d' - d"
                "d < u x" "u x < d + 1" "d' < u y" "u y < d' + 1"
              unfolding f_def g_def h_def by auto
              from nat_intv_frac_decomp[OF **(2,3)] nat_intv_frac_decomp[OF **(4,5)] **(1) have
                "frac (u y) < frac (u x)"
              by simp
              with ‹frac _  _ show False by auto
            qed
          qed
        qed
      qed
    qed
  qed
  moreover have "R  [?M]v,n"
  proof
    fix u assume u: "u  R"
    show "u  [?M]v,n" unfolding DBM_zone_repr_def DBM_val_bounded_def
    proof (safe, goal_cases)
      case 1 then show ?case by auto
    next
      case (2 c)
      with clock_numbering have "c  X" by metis
      with clock_numbering have *: "c  X" "v c > 0" "v' (v c) = c" unfolding v'_def by auto
      with R u have "intv_elem c u (I c)" "valid_intv (k c) (I c)" by auto
      then have "dbm_entry_val u None (Some c) (g c)" unfolding g_def by (cases "I c") auto
      with * show ?case by auto
    next
      case (3 c)
      with clock_numbering have "c  X" by metis
      with clock_numbering have *: "c  X" "v c > 0" "v' (v c) = c" unfolding v'_def by auto
      with R u have "intv_elem c u (I c)" "valid_intv (k c) (I c)" by auto
      then have "dbm_entry_val u (Some c) None (f c)" unfolding f_def by (cases "I c") auto
      with * show ?case by auto
    next
      case (4 c1 c2)
      with clock_numbering have "c1  X" "c2  X" by metis+
      with clock_numbering have *:
        "c1  X" "v c1 > 0" "v' (v c1) = c1" "c2  X" "v c2 > 0" "v' (v c2) = c2"
      unfolding v'_def by auto
      with R u have
        "intv_elem c1 u (I c1)" "valid_intv (k c1) (I c1)"
        "intv_elem c2 u (I c2)" "valid_intv (k c2) (I c2)"
      by auto
      then have "dbm_entry_val u (Some c1) (Some c2) (h c1 c2)" unfolding h_def
      proof(cases "I c1", cases "I c2", fastforce+, cases "I c2", fastforce, goal_cases)
      case (1 d d')
        then show ?case
        proof (cases "(c2, c1)  r", goal_cases)
          case 1
          show ?case
          proof (cases "(c1, c2)  r")
            case True
            with 1 *(1,4) R(1) u have "frac (u c1) = frac (u c2)" by auto
            with 1 have "u c1 - u c2 = real d - d'" by (fastforce dest: nat_intv_frac_decomp)
            with 1 show ?thesis by auto
          next
            case False with 1 show ?thesis by auto
          qed
        next
          case 2
          show ?case
          proof (cases "c1 = c2")
            case True then show ?thesis by auto
          next
            case False
            with 2 R(2) *(1,4) have "(c1, c2)  r" by (fastforce simp: total_on_def)
            with 2 *(1,4) R(1) u have "frac (u c1) < frac (u c2)" by auto
            with 2 have "u c1 - u c2 < real d - d'" by (fastforce dest: nat_intv_frac_decomp)
            with 2 show ?thesis by auto
          qed
        qed
      qed fastforce+
      then show ?case
      proof (cases "v c1 = v c2", goal_cases)
        case True with * clock_numbering have "c1 = c2" by auto
        then show ?thesis by auto
      next
        case 2 with * show ?case by auto
      qed
    qed
  qed
  ultimately have "[?M]v,n = R" by blast
  moreover have " i  n.  j  n. ?M i 0 =   j > 0  i  j  ?M i j =   ?M j i = "
  unfolding f_def h_def by auto
  moreover have " i  n. ?M i i = Le 0" by auto
  moreover
  { fix i j assume A: "i  n" "j  n" "i > 0" "j > 0" "?M i 0  " "?M j 0  "
    with clock_numbering(2) obtain c1 c2 where B: "v c1 = i" "v c2 = j" "c1  X" "c2  X" by meson
    with clock_numbering(1) A have C: "v' i = c1" "v' j = c2" unfolding v'_def by force+
    from R(2) B have valid: "valid_intv (k c1) (I c1)" "valid_intv (k c2) (I c2)" by auto
    have " d :: int. (- k (v' j)  d  d  k (v' i)  ?M i j = Le d  ?M j i = Le (-d)
       (- k (v' j)  d - 1  d  k (v' i)  ?M i j = Lt d  ?M j i = Lt (-d + 1)))"
    proof (cases "i = j")
      case True
      then show ?thesis by auto
    next
      case False
      then show ?thesis
      proof (cases "I c1", goal_cases)
        case 1
        then show ?case
        proof (cases "I c2")
          case Const
          let ?d = "int (intv_const (I c1)) - int (intv_const (I c2))"
          from Const 1 have "isConst (I c1)" "isConst (I c2)" by auto
          with A(1-4) C valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
        next
          case Intv
          let ?d = "int(intv_const (I c1)) - int (intv_const (I c2))"
          from Intv 1 have "isConst (I c1)" "isIntv (I c2)" by auto
          with A(1-4) C valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
        next
          case Greater
          then have "¬ isIntv (I c2)" "¬ isConst (I c2)" by auto
          with A 1(1) C have False unfolding f_def by simp
          then show ?thesis by fast
        qed
      next
        case 2
        then show ?case
        proof (cases "I c2")
          case Const
          let ?d = "int (intv_const (I c1)) + 1 - int (intv_const (I c2))"
          from Const 2 have "isIntv (I c1)" "isConst (I c2)" by auto
          with A(1-4) C valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
        next
          case Intv
          with 2 have *: "isIntv (I c1)" "isIntv (I c2)" by auto
          from Intv A(1-4) C show ?thesis apply simp
          proof (standard, goal_cases)
            case 1
            show ?case
            proof (cases "(c2, c1)  r")
              case True
              note T = this
              show ?thesis
              proof (cases "(c1, c2)  r")
                case True
                let ?d = "int (intv_const (I c1)) - int (intv_const (I c2))"
                from True T * valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
              next
                case False
                let ?d = "int (intv_const (I c1)) - int (intv_const (I c2)) + 1"
                from False T * valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
              qed
            next
              case False
              let ?d = "int (intv_const (I c1)) - int (intv_const (I c2))"
              from False * valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
            qed
          qed
        next
          case Greater
          then have "¬ isIntv (I c2)" "¬ isConst (I c2)" by auto
          with A 2(1) C have False unfolding f_def by simp
          then show ?thesis by fast
        qed
      next
        case 3
        then have "¬ isIntv (I c1)" "¬ isConst (I c1)" by auto
        with A 3(1) C have False unfolding f_def by simp
        then show ?thesis by fast
      qed
    qed
  }
  moreover
  { fix i assume A: "i  n" "i > 0" "?M i 0  "
    with clock_numbering(2) obtain c1 where B: "v c1 = i" "c1  X" by meson
    with clock_numbering(1) A have C: "v' i = c1" unfolding v'_def by force+
    from R(2) B have valid: "valid_intv (k c1) (I c1)" by auto
    have " d :: int. d  k (v' i)  d  0
       (?M i 0 = Le d  ?M 0 i = Le (-d)  ?M i 0 = Lt d  ?M 0 i = Lt (-d + 1))"
    proof (cases "i = 0")
      case True
      then show ?thesis by auto
    next
      case False
      then show ?thesis
      proof (cases "I c1", goal_cases)
        case 1
        let ?d = "int (intv_const (I c1))"
        from 1 have "isConst (I c1)" "¬ isIntv (I c1)" by auto
        with A C valid show ?thesis unfolding f_def g_def by (intro exI[where x = ?d]) auto
      next
        case 2
        let ?d = "int (intv_const (I c1)) + 1"
        from 2 have "isIntv(I c1)" "¬ isConst (I c1)" by auto
        with A C valid show ?thesis unfolding f_def g_def by (intro exI[where x = ?d]) auto
      next
        case 3
        then have "¬ isIntv (I c1)" "¬ isConst (I c1)" by auto
        with A 3(1) C have False unfolding f_def by simp
        then show ?thesis by fast
      qed
    qed
  }
  moreover
  { fix i assume A: "i  n" "i > 0"
    with clock_numbering(2) obtain c1 where B: "v c1 = i" "c1  X" by meson
    with clock_numbering(1) A have C: "v' i = c1" unfolding v'_def by force+
    from R(2) B have valid: "valid_intv (k c1) (I c1)" by auto
    have " d :: int. - k (v' i)  d  d  0  (?M 0 i = Le d  ?M 0 i = Lt d)"
    proof (cases "i = 0")
      case True
      then show ?thesis by auto
    next
      case False
      then show ?thesis
      proof (cases "I c1", goal_cases)
        case 1
        let ?d = "- int (intv_const (I c1))"
        from 1 have "isConst (I c1)" "¬ isIntv (I c1)" by auto
        with A C valid show ?thesis unfolding f_def g_def by (intro exI[where x = ?d]) auto
      next
        case 2
        let ?d = "- int (intv_const (I c1))"
        from 2 have "isIntv(I c1)" "¬ isConst (I c1)" by auto
        with A C valid show ?thesis unfolding f_def g_def by (intro exI[where x = ?d]) auto
      next
        case 3
        let ?d = "- (k c1)"
        from 3 have "¬ isIntv (I c1)" "¬ isConst (I c1)" by auto
        with A C show ?thesis unfolding g_def by (intro exI[where x = ?d]) auto
      qed
    qed
  }
  moreover have " i.  j. ?M i j    get_const (?M i j)  " unfolding f_def g_def h_def by auto
  moreover have " i  n.  j  n. i > 0  j > 0  ?M i j  
     ( d:: int. (?M i j = Le d  ?M i j = Lt d)  (- k (v' j))  d  d  k (v' i))"
  proof (auto, goal_cases)
    case A: (1 i j)
    with clock_numbering(2) obtain c1 c2 where B: "v c1 = i" "c1  X" "v c2 = j" "c2  X" by meson
    with clock_numbering(1) A have C: "v' i = c1" "v' j = c2" unfolding v'_def by force+
    from R(2) B have valid: "valid_intv (k c1) (I c1)" "valid_intv (k c2) (I c2)" by auto
    with A B C show ?case
    proof (simp, goal_cases)
      case 1
      show ?case
      proof (cases "I c1", goal_cases)
        case 1
        then show ?case
        proof (cases "I c2")
          case Const
          let ?d = "int (intv_const (I c1)) - int (intv_const (I c2))"
          from Const 1 have "isConst (I c1)" "isConst (I c2)" by auto
          with A(1-4) C valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
        next
          case Intv
          let ?d = "int(intv_const (I c1)) - int (intv_const (I c2))"
          from Intv 1 have "isConst (I c1)" "isIntv (I c2)" by auto
          with A(1-4) C valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
        next
          case Greater
          then have "¬ isIntv (I c2)" "¬ isConst (I c2)" by auto
          with A 1(1) C show ?thesis unfolding h_def by simp
        qed
      next
        case 2
        then show ?case
        proof (cases "I c2")
          case Const
          let ?d = "int (intv_const (I c1)) + 1 - int (intv_const (I c2))"
          from Const 2 have "isIntv (I c1)" "isConst (I c2)" by auto
          with A(1-4) C valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
        next
          case Intv
          with 2 have *: "isIntv (I c1)" "isIntv (I c2)" by auto
          from Intv A(1-4) C show ?thesis
          proof goal_cases
            case 1
            show ?case
            proof (cases "(c2, c1)  r")
              case True
              note T = this
              show ?thesis
              proof (cases "(c1, c2)  r")
                case True
                let ?d = "int (intv_const (I c1)) - int (intv_const (I c2))"
                from True T * valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
              next
                case False
                let ?d = "int (intv_const (I c1)) - int (intv_const (I c2)) + 1"
                from False T * valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
              qed
            next
              case False
              let ?d = "int (intv_const (I c1)) - int (intv_const (I c2))"
              from False * valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
            qed
          qed
        next
          case Greater
          then have "¬ isIntv (I c2)" "¬ isConst (I c2)" by auto
          with A 2(1) C show ?thesis unfolding h_def by simp
        qed
      next
        case 3
        then have "¬ isIntv (I c1)" "¬ isConst (I c1)" by auto
        with A 3(1) C show ?thesis unfolding h_def by simp
      qed
    qed
  qed
  moreover show ?thesis
    apply (rule that)
           apply (rule calculation(1))
          apply (rule calculation(2))
         apply (rule calculation(3))
        apply (blast intro: calculation)+
     apply (rule calculation(7))
    using calculation(8) apply blast
  done
qed

lemma len_inf_elem:
  "(a, b)  set (arcs i j xs)  M a b =   len M i j xs = "
apply (induction rule: arcs.induct)
  apply (auto simp: mult)
  apply (rename_tac a' b' x xs)
  apply (case_tac "M a' x")
by auto

lemma dbm_add_strict_right_mono_neutral: "a < Le d  a + Le (-d) < Le 0"
unfolding less mult by (cases a) (auto elim!: dbm_lt.cases)

lemma dbm_lt_not_inf_less[intro]: "A    A  " by (cases A) auto

lemma add_inf[simp]:
  "a +  = " " + a = "
unfolding mult by (cases a) auto

lemma inf_lt[simp,dest!]:
  " < x  False"
by (cases x) (auto simp: less)

lemma zone_diag_lt:
  assumes "a  n" "b  n" and C: "v c1 = a" "v c2 = b" and not0: "a > 0" "b > 0"
  shows "[(λ i j. if i = a  j = b then Lt d else )]v,n = {u. u c1 - u c2 < d}"
unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (standard, goal_cases)
  case 1
  then show ?case using a  n b  n C by fastforce
next
  case 2
  then show ?case
  proof (safe, goal_cases)
    case 1 from not0 show ?case unfolding dbm_le_def by auto
  next
    case 2 with not0 show ?case by auto
  next
    case 3 with not0 show ?case by auto
  next
    case (4 u' y z)
    show ?case
    proof (cases "v y = a  v z = b")
      case True
      with 4 clock_numbering C a  n b  n have "u' y - u' z < d" by metis
      with True show ?thesis by auto
    next
      case False then show ?thesis by auto
    qed
  qed
qed

lemma zone_diag_le:
  assumes "a  n" "b  n" and C: "v c1 = a" "v c2 = b" and not0: "a > 0" "b > 0"
  shows "[(λ i j. if i = a  j = b then Le d else )]v,n = {u. u c1 - u c2  d}"
unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (rule, goal_cases)
  case 1
  then show ?case using a  n b  n C by fastforce
next
  case 2
  then show ?case
  proof (safe, goal_cases)
    case 1 from not0 show ?case unfolding dbm_le_def by auto
  next
    case 2 with not0 show ?case by auto
  next
    case 3 with not0 show ?case by auto
  next
    case (4 u' y z)
    show ?case
    proof (cases "v y = a  v z = b")
      case True
      with 4 clock_numbering C a  n b  n have "u' y - u' z  d" by metis
      with True show ?thesis by auto
    next
      case False then show ?thesis by auto
    qed
  qed
qed

lemma zone_diag_lt_2:
  assumes "a  n" and C: "v c = a" and not0: "a > 0"
  shows "[(λ i j. if i = a  j = 0 then Lt d else )]v,n = {u. u c < d}"
unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (rule, goal_cases)
  case 1
  then show ?case using a  n C by fastforce
next
  case 2
  then show ?case
  proof (safe, goal_cases)
    case 1 from not0 show ?case unfolding dbm_le_def by auto
  next
    case 2 with not0 show ?case by auto
  next
    case (3 u c)
    show ?case
    proof (cases "v c = a")
      case False then show ?thesis by auto
    next
      case True
      with 3 clock_numbering C a  n have "u c < d" by metis
      with C show ?thesis by auto
    qed
  next
    case (4 u' y z)
    from clock_numbering(1) have "0 < v z" by auto
    then show ?case by auto
  qed
qed

lemma zone_diag_le_2:
  assumes "a  n" and C: "v c = a" and not0: "a > 0"
  shows "[(λ i j. if i = a  j = 0 then Le d else )]v,n = {u. u c  d}"
unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (rule, goal_cases)
  case 1
  then show ?case using a  n C by fastforce
next
  case 2
  then show ?case
  proof (safe, goal_cases)
    case 1 from not0 show ?case unfolding dbm_le_def by auto
  next
    case 2 with not0 show ?case by auto
  next
    case (3 u c)
    show ?case
    proof (cases "v c = a")
      case False then show ?thesis by auto
    next
      case True
      with 3 clock_numbering C a  n have "u c  d" by metis
      with C show ?thesis by auto
    qed
  next
    case (4 u' y z)
    from clock_numbering(1) have "0 < v z" by auto
    then show ?case by auto
  qed
qed

lemma zone_diag_lt_3:
  assumes "a  n" and C: "v c = a" and not0: "a > 0"
  shows "[(λ i j. if i = 0  j = a then Lt d else )]v,n = {u. - u c < d}"
unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (rule, goal_cases)
  case 1
  then show ?case using a  n C by fastforce
next
  case 2
  then show ?case
  proof (safe, goal_cases)
    case 1 from not0 show ?case unfolding dbm_le_def by auto
  next
    case (2 u c)
    show ?case
    proof (cases "v c = a", goal_cases)
      case False then show ?thesis by auto
    next
      case True
      with 2 clock_numbering C a  n have "- u c < d" by metis
      with C show ?thesis by auto
    qed
  next
    case (3 u) with not0 show ?case by auto
  next
    case (4 u' y z)
    from clock_numbering(1) have "0 < v y" by auto
    then show ?case by auto
  qed
qed

lemma len_int_closed:
  " i j. (M i j :: real)    len M i j xs  "
by (induction xs arbitrary: i) auto

lemma get_const_distr:
  "a    b    get_const (a + b) = get_const a + get_const b"
by (cases a) (cases b, auto simp: mult)+

lemma len_int_dbm_closed:
  " (i, j)  set (arcs i j xs). (get_const (M i j) :: real)    M i j  
   get_const (len M i j xs)    len M i j xs  "
by (induction xs arbitrary: i) (auto simp: get_const_distr, simp add: dbm_add_not_inf mult)

lemma zone_diag_le_3:
  assumes "a  n" and C: "v c = a" and not0: "a > 0"
  shows "[(λ i j. if i = 0  j = a then Le d else )]v,n = {u. - u c  d}"
unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (rule, goal_cases)
  case 1
  then show ?case using a  n C by fastforce
next
  case 2
  then show ?case
  proof (safe, goal_cases)
    case 1 from not0 show ?case unfolding dbm_le_def by auto
  next
    case (2 u c)
    show ?case
    proof (cases "v c = a")
      case False then show ?thesis by auto
    next
      case True
      with 2 clock_numbering C a  n have "- u c  d" by metis
      with C show ?thesis by auto
    qed
  next
    case (3 u) with not0 show ?case by auto
  next
    case (4 u' y z)
    from clock_numbering(1) have "0 < v y" by auto
    then show ?case by auto
  qed
qed

lemma dbm_lt':
  assumes "[M]v,n  V" "M a b  Lt d" "a  n" "b  n" "v c1 = a" "v c2 = b" "a > 0" "b > 0"
  shows "[M]v,n  {u  V. u c1 - u c2 < d}"
proof -
  from assms have "[M]v,n  [(λ i j. if i = a  j = b then Lt d else )]v,n"
    apply safe
    apply (rule DBM_le_subset)
  unfolding less_eq dbm_le_def by auto
  moreover from zone_diag_lt[OF a  n b  n assms(5-)]
  have "[(λ i j. if i = a  j = b then Lt d else )]v,n = {u. u c1 - u c2 < d}" by blast
  moreover from assms have "[M]v,n  V" by auto
  ultimately show ?thesis by auto
qed

lemma dbm_lt'2:
  assumes "[M]v,n  V" "M a 0  Lt d" "a  n" "v c1 = a" "a > 0"
  shows "[M]v,n  {u  V. u c1 < d}"
proof -
  from assms(2) have "[M]v,n  [(λ i j. if i = a  j = 0 then Lt d else )]v,n"
    apply safe
    apply (rule DBM_le_subset)
  unfolding less_eq dbm_le_def by auto
  moreover from zone_diag_lt_2[OF a  n assms(4,5)]
  have "[(λ i j. if i = a  j = 0 then Lt d else )]v,n = {u. u c1 < d}" by blast
  ultimately show ?thesis using assms(1) by auto
qed

lemma dbm_lt'3:
  assumes "[M]v,n  V" "M 0 a  Lt d" "a  n" "v c1 = a" "a > 0"
  shows "[M]v,n  {u  V. - u c1 < d}"
proof -
  from assms(2) have "[M]v,n  [(λ i j. if i = 0  j = a then Lt d else )]v,n"
    apply safe
    apply (rule DBM_le_subset)
  unfolding less_eq dbm_le_def by auto
  moreover from zone_diag_lt_3[OF a  n assms(4,5)]
  have "[(λ i j. if i = 0  j = a then Lt d else )]v,n = {u. - u c1 < d}" by blast
  ultimately show ?thesis using assms(1) by auto
qed

lemma dbm_le':
  assumes "[M]v,n  V" "M a b  Le d" "a  n" "b  n" "v c1 = a" "v c2 = b" "a > 0" "b > 0"
  shows "[M]v,n  {u  V. u c1 - u c2  d}"
proof -
  from assms have "[M]v,n  [(λ i j. if i = a  j = b then Le d else )]v,n"
    apply safe
    apply (rule DBM_le_subset)
  unfolding less_eq dbm_le_def by auto
  moreover from zone_diag_le[OF a  n b  n assms(5-)]
  have "[(λ i j. if i = a  j = b then Le d else )]v,n = {u. u c1 - u c2  d}" by blast
  moreover from assms have "[M]v,n  V" by auto
  ultimately show ?thesis by auto
qed

lemma dbm_le'2:
  assumes "[M]v,n  V" "M a 0  Le d" "a  n" "v c1 = a" "a > 0"
  shows "[M]v,n  {u  V. u c1  d}"
proof -
  from assms(2) have "[M]v,n  [(λ i j. if i = a  j = 0 then Le d else )]v,n"
    apply safe
    apply (rule DBM_le_subset)
  unfolding less_eq dbm_le_def by auto
  moreover from zone_diag_le_2[OF a  n assms(4,5)]
  have "[(λ i j. if i = a  j = 0 then Le d else )]v,n = {u. u c1  d}" by blast
  ultimately show ?thesis using assms(1) by auto
qed

lemma dbm_le'3:
  assumes "[M]v,n  V" "M 0 a  Le d" "a  n" "v c1 = a" "a > 0"
  shows "[M]v,n  {u  V. - u c1  d}"
proof -
  from assms(2) have "[M]v,n  [(λ i j. if i = 0  j = a then Le d else )]v,n"
    apply safe
    apply (rule DBM_le_subset)
  unfolding less_eq dbm_le_def by auto
  moreover from zone_diag_le_3[OF a  n assms(4,5)]
  have "[(λ i j. if i = 0  j = a then Le d else )]v,n = {u. - u c1  d}" by blast
  ultimately show ?thesis using assms(1) by auto
qed

lemma int_zone_dbm:
  assumes " (_,d)  collect_clock_pairs cc. d  " " c  collect_clks cc. v c  n"
  obtains M where "{u. u  cc} = [M]v,n" and "dbm_int M n"
using int_zone_dbm[OF _ assms] clock_numbering(1) by auto

lemma non_empty_dbm_diag_set':
  assumes "clock_numbering' v n" "in. jn. M i j    get_const (M i j)  "
          "[M]v,n  {}"
  obtains M' where "[M]v,n = [M']v,n  (in. jn. M' i j    get_const (M' i j)  )
     ( i  n. M' i i = 𝟭)"
proof -
  let ?M = "λi j. if i = j then 𝟭 else M i j"
  from non_empty_dbm_diag_set[OF assms(1,3)] have "[M]v,n = [?M]v,n" by auto
  moreover from assms(2) have "in. jn. ?M i j    get_const (?M i j)  "
  unfolding neutral by auto
  moreover have " i  n. ?M i i = 𝟭" by auto
  ultimately show ?thesis by (auto intro: that)
qed

lemma dbm_entry_int:
  "x    get_const x     d :: int. x = Le d  x = Lt d"
apply (cases x) using Ints_cases by auto

abbreviation "vabstr  beta_interp.vabstr"


section ‹Bouyer's Main Theorem›

theorem region_zone_intersect_empty_approx_correct:
  assumes "R  ℛ" "Z  V" "R  Z = {}" "vabstr Z M"
  shows "R  Approxβ Z = {}"
proof -
  define v' where "v' i = (THE c. c  X  v c = i)" for i
  from region_dbm[OF assms(1)] obtain MR where MR:
    "[MR]v,n = R" "in. jn. MR i 0 =   0 < j  i  j  MR i j =   MR j i = "
    "in. MR i i = Le 0"
    "in. jn. 0 < i  0 < j  MR i 0    MR j 0   
     (d. - int (k (THE c. c  X  v c = j))  d  d  int (k (THE c. c  X  v c = i))
           MR i j = Le d  MR j i = Le (real_of_int (- d))
         - int (k (THE c. c  X  v c = j))  d - 1  d  int (k (THE c. c  X  v c = i))
           MR i j = Lt d  MR j i = Lt (real_of_int (- d + 1)))"
    "in. 0 < i  MR i 0    (dint (k (THE c. c  X  v c = i)). d  0 
      (MR i 0 = Le d  MR 0 i = Le (real_of_int (- d))  MR i 0 = Lt d  MR 0 i = Lt (real_of_int (- d + 1))))"
    "in. 0 < i  (d- int (k (THE c. c  X  v c = i)). d  0  (MR 0 i = Le d  MR 0 i = Lt d))"
    "i j. MR i j    get_const (MR i j)  "
    "in. jn. MR i j    0 < i  0 < j  (d. (MR i j = Le d  MR i j = Lt d)
         - int (k (THE c. c  X  v c = j))  d  d  int (k (THE c. c  X  v c = i)))"
  .
  show ?thesis
  proof (cases "R = {}")
    case True then show ?thesis by auto
  next
    case False
    from clock_numbering(2) have cn_weak: "kn. 0 < k  ( c. v c = k)" by auto
    
    show ?thesis
    proof (cases "Z = {}")
      case True
      then show ?thesis using beta_interp.apx_empty by blast
    next
      case False
      from assms(4) have
        "Z = [M]v,n" " in.  jn. M i j    get_const (M i j)  "
      by auto
      from this(1) non_empty_dbm_diag_set'[OF clock_numbering(1) this(2)] Z  {} obtain M where M:
        "Z = [M]v,n  (in. jn. M i j    get_const (M i j)  )  (in. M i i = 𝟭)"
      by auto
      with not_empty_cyc_free[OF cn_weak] False have "cyc_free M n" by auto
      then have "cycle_free M n" using cycle_free_diag_equiv by auto
      from M have "Z = [FW M n]v,n" unfolding neutral by (auto intro!: FW_zone_equiv[OF cn_weak])
      moreover from fw_canonical[OF ‹cycle_free M _] M have "canonical (FW M n) n" unfolding neutral by auto
      moreover from FW_int_preservation M have
        "in. jn. FW M n i j    get_const (FW M n i j)  "
      by auto
      ultimately obtain M where M:
        "[M]v,n = Z" "canonical M n" "in. jn. M i j    get_const (M i j)  "
      by blast
      let ?M = "λ i j. min (M i j) (MR i j)"
      from M(1) MR(1) assms have "[M]v,n  [MR]v,n = {}" by auto
      moreover from DBM_le_subset[folded less_eq, of n ?M M] have "[?M]v,n  [M]v,n" by auto
      moreover from DBM_le_subset[folded less_eq, of n ?M MR] have "[?M]v,n  [MR]v,n" by auto
      ultimately have "[?M]v,n = {}" by blast
      then have "¬ cyc_free ?M n" using cyc_free_not_empty[of n ?M v] clock_numbering(1) by auto
      then obtain i xs where xs: "i  n" "set xs  {0..n}" "len ?M i i xs < 𝟭" by auto
      from this(1,2) canonical_shorten_rotate_neg_cycle[OF M(2) this(2,1,3)] obtain i ys where ys:
        "len ?M i i ys < 𝟭"
        "set ys  {0..n}" "successive (λ(a, b). ?M a b = M a b) (arcs i i ys)" "i  n"
        and distinct: "distinct ys" "i  set ys"
        and cycle_closes: "ys  []  ?M i (hd ys)  M i (hd ys)  ?M (last ys) i  M (last ys) i"
      by fastforce
      
      have one_M_aux:
        "len ?M i j ys = len MR i j ys" if " (a,b)  set (arcs i j ys). M a b  MR a b" for j
      using that by (induction ys arbitrary: i) (auto simp: min_def)
      have one_M: " (a,b)  set (arcs i i ys). M a b < MR a b"
      proof (rule ccontr, goal_cases)
        case 1
        then have "(a, b)set (arcs i i ys). MR a b  M a b" by auto
        from one_M_aux[OF this] have "len ?M i i ys = len MR i i ys" .
        with Nil ys(1) xs(3) have "len MR i i ys < 𝟭" by simp
        from DBM_val_bounded_neg_cycle[OF _ i  n ‹set ys  _ this cn_weak]
        have "[MR]v,n = {}" unfolding DBM_zone_repr_def by auto
        with R  {} MR(1) show False by auto
      qed
      have one_M_R_aux:
        "len ?M i j ys = len M i j ys" if " (a,b)  set (arcs i j ys). M a b  MR a b" for j
      using that by (induction ys arbitrary: i) (auto simp: min_def)
      have one_M_R: " (a,b)  set (arcs i i ys). M a b > MR a b"
      proof (rule ccontr, goal_cases)
        case 1
        then have "(a, b)set (arcs i i ys). MR a b  M a b" by auto
        from one_M_R_aux[OF this] have "len ?M i i ys = len M i i ys" .
        with Nil ys(1) xs(3) have "len M i i ys < 𝟭" by simp
        from DBM_val_bounded_neg_cycle[OF _ i  n ‹set ys  _ this cn_weak]
        have "[M]v,n = {}" unfolding DBM_zone_repr_def by auto
        with Z  {} M(1) show False by auto
      qed
      
      have 0: "(0,0)  set (arcs i i ys)"
      proof (cases "ys = []")
        case False with distinct show ?thesis using arcs_distinct1 by blast 
      next
        case True with ys(1) have "?M i i < 𝟭" by auto
        then have "M i i < 𝟭  MR i i < 𝟭" by (simp add: min_less_iff_disj)
        from one_M one_M_R True show ?thesis by auto
      qed
      
      { fix a b assume A: "(a,b)  set (arcs i i ys)"
        assume not0: "a > 0"
        from aux1[OF ys(4,4,2) A] have C2: "a  n" by auto
        then obtain c1 where C: "v c1 = a" "c1  X"
        using clock_numbering(2) not0 unfolding v'_def by meson
        then have "v' a = c1" using clock_numbering C2 not0 unfolding v'_def by fastforce
        with C C2 have " c  X. v c = a  v' a = c" "a  n" by auto
      } note clock_dest_1 = this
      { fix a b assume A: "(a,b)  set (arcs i i ys)"
        assume not0: "b > 0"
        from aux1[OF ys(4,4,2) A] have C2: "b  n" by auto
        then obtain c2 where C: "v c2 = b" "c2  X"
        using clock_numbering(2) not0 unfolding v'_def by meson
        then have "v' b = c2" using clock_numbering C2 not0 unfolding v'_def by fastforce
        with C C2 have " c  X. v c = b  v' b = c" "b  n" by auto
      } note clock_dest_2 = this
      have clock_dest:
        " a b. (a,b)  set (arcs i i ys)  a > 0  b > 0 
           c1  X.  c2  X. v c1 = a  v c2 = b  v' a = c1  v' b = c2 &&& a  n &&& b  n"
      using clock_dest_1 clock_dest_2 by (auto) presburger
      
      { fix a assume A: "(a,0)  set (arcs i i ys)"
        assume not0: "a > 0"
        assume bounded: "MR a 0  " 
        assume lt: "M a 0 < MR a 0"
        from clock_dest_1[OF A not0] obtain c1 where C:
          "v c1 = a" "c1  X" "v' a = c1" and C2: "a  n"
        by blast
        from C2 not0 bounded MR(5) obtain d :: int where *:
          "d  int (k (v' a))"
          "MR a 0 = Le d  MR 0 a = Le (- d)  MR a 0 = Lt d  MR 0 a = Lt (- d + 1)"
        unfolding v'_def by auto
        with C have **: "d  int (k c1)" by auto
        from *(2) have ?thesis
        proof (standard, goal_cases)
          case 1
          with lt have "M a 0 < Le d" by auto
          then have "M a 0  Lt d" unfolding less less_eq dbm_le_def by (fastforce elim!: dbm_lt.cases)
          from dbm_lt'2[OF assms(2)[folded M(1)] this C2 C(1) not0] have
            "[M]v,n  {u  V. u c1 < d}"
          by auto
          from beta_interp.β_boundedness_lt'[OF ** C(2) this] have
            "Approxβ ([M]v,n)  {u  V. u c1 < d}"
          .
          moreover
          { fix u assume u: "u  [MR]v,n"
            with C C2 have
              "dbm_entry_val u (Some c1) None (MR a 0)" "dbm_entry_val u None (Some c1) (MR 0 a)"
            unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
            then have "u c1 = d" using 1 by auto
            then have "u  {u  V. u c1 < d}" by auto
          }
          ultimately show ?thesis using MR(1) M(1) by auto
        next
          case 2
          from 2 lt have "M a 0  " by auto
          with dbm_entry_int[OF this] M(3) a  n
          obtain d' :: int where d': "M a 0 = Le d'  M a 0 = Lt d'" by auto
          then have "M a 0  Le (d - 1)" using lt 2
          apply (auto simp: less_eq dbm_le_def less)
           apply (cases rule: dbm_lt.cases)
                 apply auto
          apply rule
          apply (cases rule: dbm_lt.cases)
          by auto
          with lt have "M a 0  Le (d - 1)" by auto
          from dbm_le'2[OF assms(2)[folded M(1)] this C2 C(1) not0] have
            "[M]v,n  {u  V. u c1  d - 1}"
          by auto
          from beta_interp.β_boundedness_le'[OF _ C(2) this] ** have
            "Approxβ ([M]v,n)  {u  V. u c1  d - 1}"
          by auto
          moreover
          { fix u assume u: "u  [MR]v,n"
            with C C2 have
              "dbm_entry_val u None (Some c1) (MR 0 a)"
            unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
            then have "u c1 > d - 1" using 2 by auto
            then have "u  {u  V. u c1  d - 1}" by auto
          }
          ultimately show ?thesis using MR(1) M(1) by auto
        qed
      } note bounded_zero_1 = this
      
      { fix a assume A: "(0,a)  set (arcs i i ys)"
        assume not0: "a > 0"
        assume bounded: "MR a 0  " 
        assume lt: "M 0 a < MR 0 a"
        from clock_dest_2[OF A not0] obtain c1 where C:
          "v c1 = a" "c1  X" "v' a = c1" and C2: "a  n"
        by blast
        from C2 not0 bounded MR(5) obtain d :: int where *:
          "d  int (k (v' a))"
          "MR a 0 = Le d  MR 0 a = Le (- d)  MR a 0 = Lt d  MR 0 a = Lt (- d + 1)"
        unfolding v'_def by auto
        with C have **: "- int (k c1)  - d" by auto
        from *(2) have ?thesis
        proof (standard, goal_cases)
          case 1
          with lt have "M 0 a < Le (-d)" by auto
          then have "M 0 a  Lt (-d)" unfolding less less_eq dbm_le_def by (fastforce elim!: dbm_lt.cases)
          from dbm_lt'3[OF assms(2)[folded M(1)] this C2 C(1) not0] have
            "[M]v,n  {u  V. d < u c1}"
          by auto
          from beta_interp.β_boundedness_gt'[OF _ C(2) this] ** have
            "Approxβ ([M]v,n)  {u  V. - u c1 < -d}"
          by auto
          moreover
          { fix u assume u: "u  [MR]v,n"
            with C C2 have
              "dbm_entry_val u (Some c1) None (MR a 0)" "dbm_entry_val u None (Some c1) (MR 0 a)"
            unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
            with 1 have "u  {u  V. - u c1 < -d}" by auto
          }
          ultimately show ?thesis using MR(1) M(1) by auto
        next
          case 2
          from 2 lt have "M 0 a  " by auto
          with dbm_entry_int[OF this] M(3) a  n
          obtain d' :: int where d': "M 0 a = Le d'  M 0 a = Lt d'" by auto
          then have "M 0 a  Le (-d)" using lt 2
            apply (auto simp: less_eq dbm_le_def less)
             apply (cases rule: dbm_lt.cases)
                    apply auto
             apply rule
             apply (metis get_const.simps(2) 2 of_int_less_iff of_int_minus zless_add1_eq)
            apply (cases rule: dbm_lt.cases)
            apply auto
            apply (rule dbm_lt.intros(5))
          by (simp add: int_lt_Suc_le)
          from dbm_le'3[OF assms(2)[folded M(1)] this C2 C(1) not0] have
            "[M]v,n  {u  V. d  u c1}"
          by auto
          from beta_interp.β_boundedness_ge'[OF _ C(2) this] ** have
            "Approxβ ([M]v,n)  {u  V. - u c1  -d}"
          by auto
          moreover
          { fix u assume u: "u  [MR]v,n"
            with C C2 have
              "dbm_entry_val u (Some c1) None (MR a 0)"
            unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
            with 2 have "u  {u  V. - u c1  -d}" by auto
          }
          ultimately show ?thesis using MR(1) M(1) by auto
        qed
      } note bounded_zero_2 = this
      
      { fix a b c c1 c2 assume A: "(a,b)  set (arcs i i ys)"
        assume not0: "a > 0" "b > 0"
        assume lt: "M a b = Lt c"
        assume neg: "M a b + MR b a < 𝟭"
        assume C: "v c1 = a" "v c2 = b" "c1  X" "c2  X" and C2: "a  n" "b  n"
        assume valid: "-k c2  -get_const (MR b a)" "-get_const (MR b a)  k c1"
        from neg have "MR b a  " by auto
        then obtain d where *: "MR b a = Le d  MR b a = Lt d" by (cases "MR b a", auto)+
        with MR(7) _ _ _   have "d  " by fastforce
        with * obtain d :: int where *: "MR b a = Le d  MR b a = Lt d" using Ints_cases by auto 
        with valid have valid: "- k c2  -d" "-d  k c1" by auto
        from * neg lt have "M a b  Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
        by (auto elim!: dbm_lt.cases)
        from dbm_lt'[OF assms(2)[folded M(1)] this C2 C(1,2) not0] have
          "[M]v,n  {u  V. u c1 - u c2 < - d}"
        .
        from beta_interp.β_boundedness_diag_lt'[OF valid C(3,4) this] have
          "Approxβ ([M]v,n)  {u  V. u c1 - u c2 < -d}"
        .
        moreover
        { fix u assume u: "u  [MR]v,n"
          with C C2 have
            "dbm_entry_val u (Some c2) (Some c1) (MR b a)"
          unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
          with * have "u  {u  V. u c1 - u c2 < -d}" by auto
        }
        ultimately have ?thesis using MR(1) M(1) by auto
      } note neg_sum_lt = this

      { fix a b assume A: "(a,b)  set (arcs i i ys)"
        assume not0: "a > 0" "b > 0"
        assume neg: "M a b + MR b a < 𝟭"
        from clock_dest[OF A not0] obtain c1 c2 where
          C: "v c1 = a" "v c2 = b" "c1  X" "c2  X" and C2: "a  n" "b  n"
        by blast
        then have C3: "v' a = c1" "v' b = c2" unfolding v'_def using clock_numbering(1) by auto
        from neg have inf: "M a b  " "MR b a  " by auto
        from MR(8) inf not0 C(3,4) C2 C3 obtain d :: int where d:
          "MR b a = Le d  MR b a = Lt d" "- int (k c1)  d" "d  int (k c2)"
        unfolding v'_def by auto
        from inf obtain c where c: "M a b = Le c  M a b = Lt c" by (cases "M a b") auto
        { assume **: "M a b  Lt (-d)"
          from dbm_lt'[OF assms(2)[folded M(1)] this C2 C(1,2) not0] have
            "[M]v,n  {u  V. u c1 - u c2 < (- d)}"
          .
          from beta_interp.β_boundedness_diag_lt'[OF _ _ C(3,4) this] d have
            "Approxβ ([M]v,n)  {u  V. u c1 - u c2 < -d}"
          by auto
          moreover
          { fix u assume u: "u  [MR]v,n"
            with C C2 have
              "dbm_entry_val u (Some c2) (Some c1) (MR b a)"
            unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
            with d have "u  {u  V. u c1 - u c2 < -d}" by auto
          }
          ultimately have ?thesis using MR(1) M(1) by auto
        } note aux = this
        from c have ?thesis
        proof (standard, goal_cases)
          case 2
          with neg d have "M a b  Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
          by (auto elim!: dbm_lt.cases)
          with aux show ?thesis .
        next
          case 1
          note A = this
          from d(1) show ?thesis
          proof (standard, goal_cases)
            case 1
            with A neg d have "M a b  Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
            by (auto elim!: dbm_lt.cases)
            with aux show ?thesis .
          next
            case 2
            with A neg d have "M a b  Le (-d)" unfolding less_eq dbm_le_def mult neutral less
            by (auto elim!: dbm_lt.cases)
            from dbm_le'[OF assms(2)[folded M(1)] this C2 C(1,2) not0] have
              "[M]v,n  {u  V. u c1 - u c2  - d}"
            .
            from beta_interp.β_boundedness_diag_le'[OF _ _ C(3,4) this] d have
              "Approxβ ([M]v,n)  {u  V. u c1 - u c2  -d}"
            by auto
            moreover
            { fix u assume u: "u  [MR]v,n"
              with C C2 have
                "dbm_entry_val u (Some c2) (Some c1) (MR b a)"
              unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
              with A 2 have "u  {u  V. u c1 - u c2  -d}" by auto
            }
            ultimately show ?thesis using MR(1) M(1) by auto
          qed
        qed
      } note neg_sum_1 = this

      { fix a b assume A: "(a,0)  set (arcs i i ys)"
        assume not0: "a > 0"
        assume neg: "M a 0 + MR 0 a < 𝟭"
        from clock_dest_1[OF A not0] obtain c1 where C: "v c1 = a" "c1  X" and C2: "a  n" by blast
        with clock_numbering(1) have C3: "v' a = c1" unfolding v'_def by auto
        from neg have inf: "M a 0  " "MR 0 a  " by auto
        from MR(6) not0 C2 C3 obtain d :: int where d:
          "MR 0 a = Le d  MR 0 a = Lt d" "- int (k c1)  d" "d  0"
        unfolding v'_def by auto
        from inf obtain c where c: "M a 0 = Le c  M a 0 = Lt c" by (cases "M a 0") auto
        { assume "M a 0  Lt (-d)"
          from dbm_lt'2[OF assms(2)[folded M(1)] this C2 C(1) not0] have
            "[M]v,n  {u  V. u c1 < - d}"
          .
          from beta_interp.β_boundedness_lt'[OF _ C(2) this] d have
            "Approxβ ([M]v,n)  {u  V. u c1 < -d}"
          by auto
          moreover
          { fix u assume u: "u  [MR]v,n"
            with C C2 have
              "dbm_entry_val u None (Some c1) (MR 0 a)"
            unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
            with d have "u  {u  V. u c1 < -d}" by auto
          }
          ultimately have ?thesis using MR(1) M(1) by auto
        } note aux = this
        from c have ?thesis
        proof (standard, goal_cases)
          case 2
          with neg d have "M a 0  Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
          by (auto elim!: dbm_lt.cases)
          with aux show ?thesis .
        next
          case 1
          note A = this
          from d(1) show ?thesis
          proof (standard, goal_cases)
            case 1
            with A neg d have "M a 0  Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
            by (auto elim!: dbm_lt.cases)
            with aux show ?thesis .
          next
            case 2
            with A neg d have "M a 0  Le (-d)" unfolding less_eq dbm_le_def mult neutral less
            by (auto elim!: dbm_lt.cases)
            from dbm_le'2[OF assms(2)[folded M(1)] this C2 C(1) not0] have
              "[M]v,n  {u  V. u c1  - d}"
            .
            from beta_interp.β_boundedness_le'[OF _ C(2) this] d have
              "Approxβ ([M]v,n)  {u  V. u c1  -d}"
            by auto
            moreover
            { fix u assume u: "u  [MR]v,n"
              with C C2 have
                "dbm_entry_val u None (Some c1) (MR 0 a)"
              unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
              with A 2 have "u  {u  V. u c1  -d}" by auto
            }
            ultimately show ?thesis using MR(1) M(1) by auto
          qed
        qed
      } note neg_sum_1' = this

      { fix a b assume A: "(0,b)  set (arcs i i ys)"
        assume not0: "b > 0"
        assume neg: "M 0 b + MR b 0 < 𝟭"
        from clock_dest_2[OF A not0] obtain c2 where
          C:  "v c2 = b" "c2  X" and C2: "b  n"
        by blast
        with clock_numbering(1) have C3: "v' b = c2" unfolding v'_def by auto
        from neg have "M 0 b  " "MR b 0  " by auto
        with MR(5) not0 C2 C3 obtain d :: int where d:
          "MR b 0 = Le d  MR b 0 = Lt d" "d  k c2" 
        unfolding v'_def by fastforce
        from M 0 b   obtain c where c: "M 0 b = Le c  M 0 b = Lt c" by (cases "M 0 b") auto
        { assume "M 0 b  Lt (-d)"
          from dbm_lt'3[OF assms(2)[folded M(1)] this C2 C(1) not0] have
            "[M]v,n  {u  V. u c2 > d}"
          by simp
          from beta_interp.β_boundedness_gt'[OF _ C(2) this] d have
            "Approxβ ([M]v,n)  {u  V. - u c2 < -d}"
          by auto
          moreover
          { fix u assume u: "u  [MR]v,n"
            with C C2 have
              "dbm_entry_val u (Some c2) None (MR b 0)"
            unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
            with d have "u  {u  V. - u c2 < -d}" by auto
          }
          ultimately have ?thesis using MR(1) M(1) by auto
        } note aux = this
        from c have ?thesis
        proof (standard, goal_cases)
          case 2
          with neg d have "M 0 b  Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
          by (auto elim!: dbm_lt.cases)
          with aux show ?thesis .
        next
          case A: 1
          from d(1) show ?thesis
          proof (standard, goal_cases)
            case 1
            with A neg have "M 0 b  Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
            by (auto elim!: dbm_lt.cases)
            with aux show ?thesis .
          next
            case 2
            with A neg c have "M 0 b  Le (-d)" unfolding less_eq dbm_le_def mult neutral less
            by (auto elim!: dbm_lt.cases)
            from dbm_le'3[OF assms(2)[folded M(1)] this C2 C(1) not0] have
              "[M]v,n  {u  V. u c2  d}"
            by simp
            from beta_interp.β_boundedness_ge'[OF _ C(2) this] d(2) have
              "Approxβ ([M]v,n)  {u  V. - u c2  -d}"
            by auto
            moreover
            { fix u assume u: "u  [MR]v,n"
              with C C2 have
                "dbm_entry_val u (Some c2) None (MR b 0)"
              unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
              with A 2 have "u  {u  V. - u c2  -d}" by auto
            }
            ultimately show ?thesis using MR(1) M(1) by auto
          qed
        qed
      } note neg_sum_1'' = this

      { fix a b assume A: "(a,b)  set (arcs i i ys)"
        assume not0: "b > 0" "a > 0"
        assume neg: "MR a b + M b a < 𝟭"
        from clock_dest[OF A not0(2,1)] obtain c1 c2 where
          C: "v c1 = a" "v c2 = b" "c1  X" "c2  X" and C2: "a  n" "b  n"
        by blast
        then have C3: "v' a = c1" "v' b = c2" unfolding v'_def using clock_numbering(1) by auto
        from neg have inf: "M b a  " "MR a b  " by auto
        with MR(8) not0 C(3,4) C2 C3 obtain d :: int where d:
          "MR a b = Le d  MR a b = Lt d" "d  -int (k c2)" "d  int (k c1)" 
        unfolding v'_def by blast
        from inf obtain c where c: "M b a = Le c  M b a = Lt c" by (cases "M b a") auto
        { assume "M b a  Lt (-d)"
          from dbm_lt'[OF assms(2)[folded M(1)] this C2(2,1) C(2,1) not0] have
            "[M]v,n  {u  V. u c2 - u c1 < - d}"
          .
          from beta_interp.β_boundedness_diag_lt'[OF _ _ C(4,3) this] d
          have "Approxβ ([M]v,n)  {u  V. u c2 - u c1 < -d}" by auto
          moreover
          { fix u assume u: "u  [MR]v,n"
            with C C2 have
              "dbm_entry_val u (Some c1) (Some c2) (MR a b)"
            unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
            with d have "u  {u  V. u c2 - u c1 < -d}" by auto
          }
          ultimately have ?thesis using MR(1) M(1) by auto
        } note aux = this
        from c have ?thesis
        proof (standard, goal_cases)
          case 2
          with neg d have "M b a  Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
          by (auto elim!: dbm_lt.cases)
          with aux show ?thesis .
        next
          case A: 1
          from d(1) show ?thesis
          proof (standard, goal_cases)
            case 1
            with A neg d have "M b a  Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
            by (auto elim!: dbm_lt.cases)
            with aux show ?thesis .
          next
            case 2
            with A neg d have "M b a  Le (-d)" unfolding less_eq dbm_le_def mult neutral less
            by (auto elim!: dbm_lt.cases)
            from dbm_le'[OF assms(2)[folded M(1)] this C2(2,1) C(2,1) not0] have
              "[M]v,n  {u  V. u c2 - u c1  - d}"
            .
            from beta_interp.β_boundedness_diag_le'[OF _ _ C(4,3) this] d
            have "Approxβ ([M]v,n)  {u  V. u c2 - u c1  -d}" by auto
            moreover
            { fix u assume u: "u  [MR]v,n"
              with C C2 have
                "dbm_entry_val u (Some c1) (Some c2) (MR a b)"
              unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
              with A 2 have "u  {u  V. u c2 - u c1  -d}" by auto
            }
            ultimately show ?thesis using MR(1) M(1) by auto
          qed
        qed
      } note neg_sum_2 = this

      { fix a b assume A: "(a,0)  set (arcs i i ys)"
        assume not0: "a > 0"
        assume neg: "MR a 0 + M 0 a < 𝟭"
        from clock_dest_1[OF A not0] obtain c1 where C: "v c1 = a" "c1  X" and C2: "a  n" by blast
        with clock_numbering(1) have C3: "v' a = c1" unfolding v'_def by auto
        from neg have inf: "M 0 a  " "MR a 0  " by auto
        with MR(5) not0 C2 C3 obtain d :: int where d:
          "MR a 0 = Le d  MR a 0 = Lt d" "d  int (k c1)" "d  0"
        unfolding v'_def by auto
        from inf obtain c where c: "M 0 a = Le c  M 0 a = Lt c" by (cases "M 0 a") auto
        { assume "M 0 a  Lt (-d)"
          from dbm_lt'3[OF assms(2)[folded M(1)] this C2 C(1) not0] have
            "[M]v,n  {u  V. u c1 > d}"
          by simp
          from beta_interp.β_boundedness_gt'[OF _ C(2) this] d have
            "Approxβ ([M]v,n)  {u  V. u c1 > d}"
          by auto
          moreover
          { fix u assume u: "u  [MR]v,n"
            with C C2 have
              "dbm_entry_val u (Some c1) None (MR a 0)"
            unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
            with d have "u  {u  V. u c1 > d}" by auto
          }
          ultimately have ?thesis using MR(1) M(1) by auto
        } note aux = this
        from c have ?thesis
        proof (standard, goal_cases)
          case 2
          with neg d have "M 0 a  Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
          by (auto elim!: dbm_lt.cases)
          with aux show ?thesis .
        next
          case A: 1
          from d(1) show ?thesis
          proof (standard, goal_cases)
            case 1
            with A neg d have "M 0 a  Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
            by (auto elim!: dbm_lt.cases)
            with aux show ?thesis .
          next
            case 2
            with A neg d have "M 0 a  Le (-d)" unfolding less_eq dbm_le_def mult neutral less
            by (auto elim!: dbm_lt.cases)
            from dbm_le'3[OF assms(2)[folded M(1)] this C2 C(1) not0] have
              "[M]v,n  {u  V. u c1  d}"
            by simp
            from beta_interp.β_boundedness_ge'[OF _ C(2) this] d have
              "Approxβ ([M]v,n)  {u  V. u c1  d}"
            by auto
            moreover
            { fix u assume u: "u  [MR]v,n"
              with C C2 have
                "dbm_entry_val u (Some c1) None (MR a 0)"
              unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
              with A 2 have "u  {u  V. u c1  d}" by auto
            }
            ultimately show ?thesis using MR(1) M(1) by auto
          qed
        qed
      } note neg_sum_2' = this

      { fix a b assume A: "(0,b)  set (arcs i i ys)"
        assume not0: "b > 0"
        assume neg: "MR 0 b + M b 0 < 𝟭"
        from clock_dest_2[OF A not0] obtain c2 where
          C:  "v c2 = b" "c2  X" and C2: "b  n"
        by blast
        with clock_numbering(1) have C3: "v' b = c2" unfolding v'_def by auto
        from neg have "M b 0  " "MR 0 b  " by auto
        with MR(6) not0 C2 C3 obtain d :: int where d:
          "MR 0 b = Le d  MR 0 b = Lt d" "-d  k c2" 
        unfolding v'_def by fastforce
        from M b 0   obtain c where c: "M b 0 = Le c  M b 0 = Lt c" by (cases "M b 0") auto
        { assume "M b 0  Lt (-d)"
          from dbm_lt'2[OF assms(2)[folded M(1)] this C2 C(1) not0] have
            "[M]v,n  {u  V. u c2 < - d}"
          by simp
          from beta_interp.β_boundedness_lt'[OF _ C(2) this] d have
            "Approxβ ([M]v,n)  {u  V. u c2 < -d}"
          by auto
          moreover
          { fix u assume u: "u  [MR]v,n"
            with C C2 have
              "dbm_entry_val u None (Some c2) (MR 0 b)"
            unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
            with d have "u  {u  V. u c2 < -d}" by auto
          }
          ultimately have ?thesis using MR(1) M(1) by auto
        } note aux = this
        from c have ?thesis
        proof (standard, goal_cases)
          case 2
          with neg d have "M b 0  Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
          by (auto elim!: dbm_lt.cases)
          with aux show ?thesis .
        next
          case 1
          note A = this
          from d(1) show ?thesis
          proof (standard, goal_cases)
            case 1
            with A neg have "M b 0  Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
            by (auto elim!: dbm_lt.cases)
            with aux show ?thesis .
          next
            case 2
            with A neg c have "M b 0  Le (-d)" unfolding less_eq dbm_le_def mult neutral less
            by (auto elim!: dbm_lt.cases)
            from dbm_le'2[OF assms(2)[folded M(1)] this C2 C(1) not0] have
              "[M]v,n  {u  V. u c2  - d}"
            by simp
            from beta_interp.β_boundedness_le'[OF _ C(2) this] d(2) have
              "Approxβ ([M]v,n)  {u  V. u c2  -d}"
            by auto
            moreover
            { fix u assume u: "u  [MR]v,n"
              with C C2 have
                "dbm_entry_val u None (Some c2) (MR 0 b)"
              unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
              with A 2 have "u  {u  V. u c2  -d}" by auto
            }
            ultimately show ?thesis using MR(1) M(1) by auto
          qed
        qed
      } note neg_sum_2'' = this

      { fix a b assume A: "(a,b)  set (arcs i i ys)"
        assume not0: "a > 0" "b > 0"
        assume bounded: "MR a 0  " "MR b 0  "
        assume lt: "M a b < MR a b"
        from clock_dest[OF A not0] obtain c1 c2 where
          C: "v c1 = a" "v c2 = b" "c1  X" "c2  X" and C2: "a  n" "b  n"
        by blast
        from C C2 clock_numbering(1,3) have C3: "v' b = c2" "v' a = c1" unfolding v'_def by blast+
        with C C2 not0 bounded MR(4) obtain d :: int where *:
          "- int (k c2)  d  d  int (k c1)  MR a b = Le d  MR b a = Le (- d)
          - int (k c2)  d - 1  d  int (k c1)  MR a b = Lt d  MR b a = Lt (- d + 1)"
        unfolding v'_def by force
        from * have ?thesis
        proof (standard, goal_cases)
          case 1
          with lt have "M a b < Le d" by auto
          then have "M a b  Lt d" unfolding less less_eq dbm_le_def by (fastforce elim!: dbm_lt.cases)
          from dbm_lt'[OF assms(2)[folded M(1)] this C2 C(1,2) not0] have
            "[M]v,n  {u  V. u c1 - u c2 < d}"
          .
          from beta_interp.β_boundedness_diag_lt'[OF _ _ C(3,4) this] 1
          have "Approxβ ([M]v,n)  {u  V. u c1 - u c2 < d}" by auto
          moreover
          { fix u assume u: "u  [MR]v,n"
            with C C2 have
              "dbm_entry_val u (Some c1) (Some c2) (MR a b)" "dbm_entry_val u (Some c2) (Some c1) (MR b a)"
            unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
            with 1 have "u  {u  V. u c1 - u c2 < d}" by auto
          }
          ultimately show ?thesis using MR(1) M(1) by auto
        next
          case 2
          with lt have "M a b  " by auto
          with dbm_entry_int[OF this] M(3) a  n b  n
          obtain d' :: int where d': "M a b = Le d'  M a b = Lt d'" by auto
          then have "M a b  Le (d - 1)" using lt 2
           apply (auto simp: less_eq dbm_le_def less)
            apply (cases rule: dbm_lt.cases)
                 apply auto
           apply (rule dbm_lt.intros)
           apply (cases rule: dbm_lt.cases)
          by auto
          with lt have "M a b  Le (d - 1)" by auto
          from dbm_le'[OF assms(2)[folded M(1)] this C2 C(1,2) not0] have
            "[M]v,n  {u  V. u c1 - u c2  d - 1}"
          .
          from beta_interp.β_boundedness_diag_le'[OF _ _ C(3,4) this] 2
          have "Approxβ ([M]v,n)  {u  V. u c1 - u c2  d - 1}" by auto
          moreover
          { fix u assume u: "u  [MR]v,n"
            with C C2 have
              "dbm_entry_val u (Some c2) (Some c1) (MR b a)"
            unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
            with 2 have "u  {u  V. u c1 - u c2  d - 1}" by auto
          }
          ultimately show ?thesis using MR(1) M(1) by auto
        qed
      } note bounded = this

      { assume not_bounded: " (a,b)  set (arcs i i ys). M a b < MR a b  MR a 0 =   MR b 0 = "
        have " y z zs. set zs  {0, y, z} = set (i # ys)  len ?M 0 0 (y # z # zs) < Le 0  
                    ( (a,b)  set (arcs 0 0 (y # z # zs)). M a b < MR a b  a = y  b = z)
                     M y z < MR y z  distinct (0 # y # z # zs)  ?thesis"
        proof (cases ys)
          case Nil
          show ?thesis
          proof (cases "M i i < MR i i")
            case True
            then have "?M i i = M i i" by (simp add: min.strict_order_iff)
            with Nil ys(1) xs(3) have *: "M i i < 𝟭" by simp
            with neg_cycle_empty[OF cn_weak _ i  n, of "[]" M] have "[M]v,n = {}" by auto
            with Z  {} M(1) show ?thesis by auto
          next
            case False
            then have "?M i i = MR i i" by (simp add: min_absorb2) 
            with Nil ys(1) xs(3) have "MR i i < 𝟭" by simp
            with neg_cycle_empty[OF cn_weak _ i  n, of "[]" MR] have "[MR]v,n = {}" by auto
            with R  {} MR(1) show ?thesis by auto
          qed
        next
          case (Cons w ws)
          note ws = this
          show ?thesis
          proof (cases ws)
            case Nil
            with ws ys xs(3) have *:
              "?M i w + ?M w i < 𝟭" "?M w i = M w i  ?M i w  M i w" "(i, w)  set (arcs i i ys)"
            by auto
            have "R  Approxβ Z = {}"
            proof (cases "?M w i = M w i")
              case True
              with *(2) have "?M i w = MR i w" unfolding min_def by auto
              with *(1) True have neg: "MR i w + M w i < 𝟭" by auto
              show ?thesis
              proof (cases "i = 0")
                case True
                show ?thesis
                proof (cases "w = 0")
                  case True with 0 i = 0 *(3) show ?thesis by auto
                next
                  case False with i = 0 neg_sum_2'' *(3) neg show ?thesis by blast
                qed
              next
                case False
                show ?thesis
                proof (cases "w = 0")
                  case True with i  0 neg_sum_2' *(3) neg show ?thesis by blast
                next
                  case False with i  0 neg_sum_2 *(3) neg show ?thesis by blast
                qed
              qed
            next
              case False
              have "MR w i < M w i"
              proof (rule ccontr, goal_cases)
                case 1
                then have "MR w i  M w i" by auto
                with False show False unfolding min_def by auto
              qed
              with one_M ws Nil have "M i w < MR i w" by auto
              then have "?M i w = M i w" unfolding min_def by auto
              moreover from False *(2) have "?M w i = MR w i" unfolding min_def by auto
              ultimately have neg: "M i w + MR w i < 𝟭" using *(1) by auto
              show ?thesis
              proof (cases "i = 0")
                case True
                show ?thesis
                proof (cases "w = 0")
                  case True with 0 i = 0 *(3) show ?thesis by auto
                next
                  case False with i = 0 neg_sum_1'' *(3) neg show ?thesis by blast
                qed
              next
                case False
                show ?thesis
                proof (cases "w = 0")
                  case True with i  0 neg_sum_1' *(3) neg show ?thesis by blast
                next
                  case False with i  0 neg_sum_1 *(3) neg show ?thesis by blast
                qed
              qed
            qed
            then show ?thesis by simp
          next
            case zs: (Cons z zs)
            from one_M obtain a b where *:
              "(a,b)  set (arcs i i ys)" "M a b < MR a b"
            by fastforce
            from cycle_rotate_3'[OF _ *(1) ys(3)] ws cycle_closes obtain ws' where ws':
              "len ?M i i ys = len ?M a a (b # ws')" "set (a # b # ws') = set (i # ys)"
              "1 + length ws' = length ys" "set (arcs i i ys) = set (arcs a a (b # ws'))"
              and successive: "successive (λ(a, b). ?M a b = M a b) (arcs a a (b # ws') @ [(a, b)])"
            by blast
            from successive have successive_arcs:
              "successive (λ(a, b). ?M a b = M a b) (arcs a b (b # ws' @ [a]))"
            using arcs_decomp_tail by auto
            from ws'(4) one_M_R *(2) obtain c d where **:
              "(c,d)  set (arcs a a (b # ws'))" "M c d > MR c d" "(a,b)  (c,d)"
            by fastforce
            from card_distinct[of "a # b # ws'"] distinct_card[of "i # ys"] ws'(2,3) distinct
            have distinct: "distinct (a # b # ws')" by simp
            from ws zs ws'(3) have "ws'  []" by auto
            then obtain z zs where z: "ws' = zs @ [z]" by (metis append_butlast_last_id)
            then have "b # ws' = (b # zs) @ [z]" by simp
            with len_decomp[OF this, of ?M a a] arcs_decomp_tail have rotated:
              "len ?M a a (b # ws') = len ?M z z (a # b # zs)"
              "set (arcs a a (b # ws')) = set (arcs z z (a # b # zs))"
            by (auto simp add: comm)
            from ys(1) xs(3) ws'(1) have "len ?M a a (b # ws') < 𝟭" by auto
            from ws'(2) ys(2) i  n z have n_bounds: "a  n" "b  n" "set ws'  {0..n}" "z  n" by auto
            from * have a_b: "?M a b = M a b" by (simp add: min.strict_order_iff)
            from successive successive_split[of _ "arcs a z (b # zs)" "[(z,a), (a,b)]"]
            have first: "successive (λ(a, b). ?M a b = M a b) (arcs a z (b # zs))" and
                 last_two: "successive (λ(a, b). ?M a b = M a b) [(z, a), (a, b)]"
            using arcs_decomp_tail z by auto
            from * not_bounded have not_bounded': "MR a 0 =   MR b 0 = " by auto
            from this(1) have "z = 0"
            proof
              assume inf: "MR b 0 = "
              from a_b successive obtain z where z: "(b,z)  set (arcs b a ws')" "?M b z  M b z"
              by (cases ws') auto
              then have "?M b z = MR b z" by (meson min_def)
              from arcs_distinct2[OF _ _ _ _ z(1)] distinct have "b  z" by auto
              from z n_bounds have "z  n"
                apply (induction ws' arbitrary: b)
                 apply auto[]
                 apply (rename_tac ws' b)
                apply (case_tac ws')
                 apply auto
              done
              have "MR b z = "
              proof (cases "z = 0")
                case True
                with inf show ?thesis by auto
              next
                case False
                with inf MR(2) b  z z  n b  n show ?thesis by blast
              qed
              with ?M b z = MR b z have "len ?M b a ws' = " by (auto intro: len_inf_elem[OF z(1)])
              then have " = len ?M a a (b # ws')" by simp
              with ‹len ?M a a _ < 𝟭 show ?thesis by auto
            next
              assume inf: "MR a 0 = "
              show "z = 0"
              proof (rule ccontr)
                assume "z  0"
                with last_two a_b have "?M z a = MR z a" by (auto simp: min_def)
                from distinct z have "a  z" by auto
                with z  0 a  n z  n MR(2) inf have "MR z a = " by blast
                with ?M z a = MR z a have "len ?M z z (a # b # zs) = " by (auto intro: len_inf_elem)
                with ‹len ?M a a _ < 𝟭 rotated show False by auto
              qed
            qed
            { fix c d assume A: "(c, d)  set (arcs 0 0 (a # b # zs))" "M c d < MR c d"
              then have *: "?M c d = M c d" by (simp add: min.strict_order_iff)
              from rotated(2) A z = 0 not_bounded ws'(4) have **: "MR c 0 =   MR d 0 = " by auto
              { assume inf: "MR c 0 = "
                fix x assume x: "(x, c)  set (arcs a 0 (b # zs))" "?M x c  M x c"
                from x(2) have "?M x c = MR x c" unfolding min_def by auto
                from arcs_elem[OF x(1)] z z = 0 have
                  "x  set (a # b # ws')" "c  set (a # b # ws')"
                by auto
                with n_bounds have "x  n" "c  n" by auto
                have "x = 0"
                proof (rule ccontr)
                  assume "x  0"
                  from distinct z arcs_distinct1[OF _ _ _ _ x(1)] z = 0have "x  c" by auto
                  with x  0 c  n x  n MR(2) inf have "MR x c = " by blast
                  with ?M x c = MR x c have
                    "len ?M a 0 (b # zs) = "
                  by (fastforce intro: len_inf_elem[OF x(1)])
                  with z = 0 have "len ?M z z (a # b # zs) = " by auto
                  with ‹len ?M a a _ < 𝟭 rotated show False by auto
                qed
                with arcs_distinct_dest1[OF _ x(1), of z] z distinct x z = 0 have False by auto
              } note c_0_inf = this
              have "a = c  b = d"
              proof (cases "(c, d) = (0, a)")
                case True
                with last_two z = 0 * a_b have False by auto
                then show ?thesis by simp
              next
                case False
                show ?thesis
                proof (rule ccontr, goal_cases)
                  case 1
                  with False A(1) have ***: "(c, d)  set (arcs b 0 zs)" by auto
                  from successive z z = 0 have
                    "successive (λ(a, b). ?M a b = M a b) ([(a, b)] @ arcs b 0 zs @ [(0, a), (a, b)])"
                  by (simp add: arcs_decomp)
                  then have ****: "successive (λ(a, b). ?M a b = M a b) (arcs b 0 zs)"
                  using successive_split[of _ "[(a, b)]" "arcs b 0 zs @ [(0, a), (a, b)]"]
                        successive_split[of _ "arcs b 0 zs" "[(0, a), (a, b)]"]
                  by auto
                  from successive_predecessor[OF *** _ this] successive z
                  obtain x where x: "(x, c)  set (arcs a 0 (b # zs))" "?M x c  M x c"
                  proof (cases "c = b")
                    case False
                    then have "zs  []" using *** by auto
                    from successive_predecessor[OF *** False **** _ this] * obtain x where x:
                      "(zs = [c]  x = b  (ys. zs = c # d # ys  x = b)
                         (ys. zs = ys @ [x, c]  d = 0)  (ys ws. zs = ys @ x # c # d # ws))"
                      "?M x c  M x c"
                    by blast+
                    from this(1) have "(x, c)  set (arcs a 0 (b # zs))" using arcs_decomp by auto
                    with x(2) show ?thesis by (auto intro: that)
                  next
                    case True
                    have ****: "successive (λ(a, b). ?M a b = M a b) (arcs a 0 (b # zs))"
                    using first z = 0 arcs_decomp successive_arcs z by auto 
                    show ?thesis
                    proof (cases zs)
                      case Nil
                      with **** True *** * show ?thesis by (auto intro: that)
                    next
                      case (Cons u us)
                      with *** True distinct z z = 0 have "distinct (b # u # us @ [0])" by auto
                      from arcs_distinct_fix[OF this] *** True Cons have "d = u" by auto
                      with **** * Cons True show ?thesis by (auto intro: that)
                    qed
                  qed
                  show False
                  proof (cases "d = 0")
                    case True
                    from ** show False
                    proof
                      assume "MR c 0 = " from c_0_inf[OF this x] show False .
                    next
                      assume "MR d 0 = " with d = 0 MR(3) show False by auto
                    qed
                  next
                    case False with *** have "zs  []" by auto
                    from successive_successor[OF (c,d)  set (arcs b 0 zs) False **** _ this] *
                    obtain e where
                      "(zs = [d]  e = 0  (ys. zs = d # e # ys)  (ys. zs = ys @ [c, d]  e = 0)
                         (ys ws. zs = ys @ c # d # e # ws))" "?M d e  M d e"
                    by blast
                    then have e: "(d, e)  set (arcs b 0 zs)" "?M d e  M d e" using arcs_decomp by auto
                    from ** show False
                    proof
                      assume inf: "MR d 0 = "
                      from e have "?M d e = MR d e" by (meson min_def)
                      from arcs_distinct2[OF _ _ _ _ e(1)] z z = 0 distinct have "d  e" by auto
                      from z n_bounds have "set zs  {0..n}" by auto
                      with e have "e  n"
                        apply (induction zs arbitrary: d)
                         apply auto
                        apply (case_tac zs)
                         apply auto
                      done
                      from n_bounds z arcs_elem(2)[OF A(1)] have "d  n" by auto
                      have "MR d e = "
                      proof (cases "e = 0")
                        case True
                        with inf show ?thesis by auto
                      next
                        case False
                        with inf MR(2) d  e e  n d  n show ?thesis by blast
                      qed
                      with ?M d e = MR d e have "len ?M b 0 zs = " by (auto intro: len_inf_elem[OF e(1)])
                      with z = 0 rotated have " = len ?M a a (b # ws')" by simp
                      with ‹len ?M a a _ < 𝟭 show ?thesis by auto
                    next
                      assume "MR c 0 = " from c_0_inf[OF this x] show False .
                    qed
                  qed
                qed
              qed
            }
            then have "(c, d)set (arcs 0 0 (a # b # zs)). M c d < MR c d  c = a  d = b"
            by blast
            moreover from ys(1) xs(3) have "len ?M i i ys < Le 0" unfolding neutral by auto
            moreover with rotated ws'(1) have "len ?M z z (a # b # zs) < Le 0" by auto
            moreover from z = 0 z ws'(2) have "set zs  {0, a, b} = set (i # ys)" by auto
            moreover from z = 0 distinct z have "distinct (0 # a # b # zs)" by auto
            ultimately show ?thesis using z = 0 M a b < MR a b by blast
          qed
        qed note * = this
        { assume "¬ ?thesis"
          with * obtain y z zs where *:
            "set zs  {0, y, z} = set (i # ys)" "len ?M 0 0 (y # z # zs) < Le 0"
            "(a, b)set (arcs 0 0 (y # z # zs)). M a b < MR a b  a = y  b = z" "M y z < MR y z"
            and distinct': "distinct (0 # y # z # zs)"
          by blast
          then have "y  0" "z  0" by auto
          let ?r = "len MR z 0 zs"
          have "(a, b)set (arcs z 0 zs). ?M a b = MR a b"
          proof (safe, goal_cases)
            case A: (1 a b)
            have "MR a b  M a b"
            proof (rule ccontr, goal_cases)
              case 1
              with *(3) A have "a = y" "b = z" by auto
              with A distinct' arcs_distinct3[OF _ A, of y] show False by auto
            qed
            then show ?case by (simp add: min_def)
          qed
          then have r: "len ?M z 0 zs = ?r" by (induction zs arbitrary: z) auto
          with *(2) have **: "?M 0 y + (?M y z + ?r) < Le 0" by simp
          from MR(1) R  {} obtain u where u: "DBM_val_bounded v u MR n"
          unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
          from *(1) i  n ‹set ys  _ have "y  n" "z  n" by fastforce+
          from *(1) ys(2,4) have "set zs  {0 ..n}" by auto
          from y  n z  n clock_numbering(2) y  0 z  0 obtain c1 c2 where C:
            "c1  X" "c2  X" "v c1 = y" "v c2 = z"
          by blast+
          with clock_numbering(1,3) have C2: "v' y = c1" "v' z = c2" unfolding v'_def by auto
          with C have "v (v' z) = z" by auto
          with DBM_val_bounded_len'1[OF u, of zs "v' z"] have "dbm_entry_val u (Some (v' z)) None ?r"
          using z  n clock_numbering(2) ‹set zs  _ distinct' by force
          from len_inf_elem ** have tl_not_inf: "(a, b)set (arcs z 0 zs). MR a b  " by fastforce
          with MR(7) len_int_dbm_closed have "get_const ?r    ?r  " by blast
          then obtain r :: int where r': "?r = Le r  ?r = Lt r" using Ints_cases by (cases ?r) auto
          from r' ‹dbm_entry_val _ _ _ _ C C2 have le: "u (v' z)  r" by fastforce
          from arcs_ex_head obtain z' where "(z, z')  set (arcs z 0 zs)" by blast
          then have z':
            "(z, z')  set (arcs 0 0 (y # z # zs))" "(z, z')  set (arcs z 0 zs)"
          by auto
          have "MR z 0  "
          proof (rule ccontr, goal_cases)
            case 1
            then have inf: "MR z 0 = " by auto
            have "MR z z' = "
            proof (cases "z' = 0")
              case True
              with 1 show ?thesis by auto
            next
              case False
              from arcs_elem[OF z'(1)] *(1) i  n ‹set ys  _ have "z'  n" by fastforce
              moreover from distinct' *(1) arcs_distinct1[OF _ _ _ _ z'(1)] have "z  z'" by auto
              ultimately show ?thesis using MR(2) z  n False inf by blast
            qed
            with tl_not_inf z'(2) show False by auto
          qed
          with MR(5) z  0 z  n obtain d :: int where d:
            "MR z 0 = Le d  MR 0 z = Le (-d)  MR z 0 = Lt d  MR 0 z = Lt (-d + 1)"
            "d  k (v' z)" "0  d"
          unfolding v'_def by auto
          text ‹Needs property that len of integral dbm entries is integral and definition of M_R›
          from this (1) have rr: "?r  MR z 0"
          proof (standard, goal_cases)
            case A: 1
            with u z  n C C2 have *: "- u (v' z)  -d" unfolding DBM_val_bounded_def by fastforce
            from r' show ?case
            proof (standard, goal_cases)
              case 1
              with le * A show ?case unfolding less_eq dbm_le_def by fastforce
            next
              case 2
              with ‹dbm_entry_val _ _ _ _ C C2 have "u (v' z) < r" by fastforce
              with * have "r > d" by auto
              with A 2 show ?case unfolding less_eq dbm_le_def by fastforce
            qed
          next
            case A: 2
            with u z  n C C2 have *: "- u (v' z) < -d + 1" unfolding DBM_val_bounded_def by fastforce
            from r' show ?case
            proof (standard, goal_cases)
              case 1
              with le * A show ?case unfolding less_eq dbm_le_def by fastforce
            next
              case 2
              with ‹dbm_entry_val _ _ _ _ C C2 have "u (v' z)  r" by fastforce
              with * have "r  d" by auto
              with A 2 show ?case unfolding less_eq dbm_le_def by fastforce
            qed
          qed
          with *(3) y  0 have "M 0 y  MR 0 y" by fastforce
          then have "?M 0 y = MR 0 y" by (simp add: min.absorb2)
          moreover from *(4) have "?M y z = M y z" unfolding min_def by auto
          ultimately have **: "MR 0 y + (M y z + MR z 0) < Le 0"
          using ** add_mono_right[OF add_mono_right[OF rr], of "MR 0 y" "M y z"] by simp
          from ** have not_inf: "MR 0 y  " "M y z  " "MR z 0  " by auto
          from MR(6) y  0 y  n obtain c :: int where c:
            "MR 0 y = Le c  MR 0 y = Lt c" "- k (v' y)  c" "c  0"
          unfolding v'_def by auto
          have ?thesis
          proof (cases "MR 0 y + MR z 0 = Lt (c + d)")
            case True
            from ** have "(MR 0 y + MR z 0) + M y z < Le 0" using comm assoc by metis
            with True have **: "Lt (c + d) + M y z < Le 0" by simp
            then have "M y z  Le (- (c + d))" unfolding less less_eq dbm_le_def mult
            by (cases "M y z") (fastforce elim!: dbm_lt.cases)+
            from dbm_le'[OF assms(2)[folded M(1)] this y  n z  n C(3,4)] y  0 z  0 M
            have subs: "Z  {u  V. u c1 - u c2  - (c + d)}" by blast
            with c d have "- k (v' z)  - (c + d)" "- (c + d)  k (v' y)" by auto
            with beta_interp.β_boundedness_diag_le'[OF _ _ C(1,2) subs] C2 have 
              "Approxβ Z  {u  V. u c1 - u c2  - (c + d)}"
            by auto
            moreover
            { fix u assume u: "u  R"
              with C y  n z  n MR(1) have
                "dbm_entry_val u (Some c2) None (MR z 0)" "dbm_entry_val u None (Some c1) (MR 0 y)"
              unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
              with True c d(1) have "u  {u  V. u c1 - u c2  - (c + d)}" unfolding mult by auto
            }
            ultimately show ?thesis by blast
          next
            case False
            with c d have "MR 0 y + MR z 0 = Le (c + d)" unfolding mult by fastforce
            moreover from ** have "(MR 0 y + MR z 0) + M y z < Le 0" using comm assoc by metis
            ultimately have **: "Le (c + d) + M y z < Le 0" by simp
            then have "M y z  Lt (- (c + d))" unfolding less less_eq dbm_le_def mult
            by (cases "M y z") (fastforce elim!: dbm_lt.cases)+
            from dbm_lt'[OF assms(2)[folded M(1)] this y  n z  n C(3,4)] y  0 z  0 M
            have subs: "Z  {u  V. u c1 - u c2 < - (c + d)}" by auto
            from c d(2-) C2 have "- k c2  - (c + d)" "- (c + d)  k c1" by auto
            from beta_interp.β_boundedness_diag_lt'[OF this C(1,2) subs] have 
              "Approxβ Z  {u  V. u c1 - u c2 < - (c + d)}"
            .
            moreover
            { fix u assume u: "u  R"
              with C y  n z  n MR(1) have
                "dbm_entry_val u (Some c2) None (MR z 0)" "dbm_entry_val u None (Some c1) (MR 0 y)"
              unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
              with c d(1) have "u  {u  V. u c1 - u c2 < - (c + d)}" by auto
            }
            ultimately show ?thesis by auto
          qed
        } then have ?thesis by auto
      }
      with bounded 0 bounded_zero_1 bounded_zero_2 show ?thesis by blast
    qed
  qed
qed


section ‹Nice Corollaries of Bouyer's Theorem›

lemma ℛ_V: "= V" unfolding V_def ℛ_def using region_cover[of X _ k] by auto

lemma regions_beta_V: "R β  R  V" unfolding V_def ℛβ_def by auto

lemma apx_V: "Z  V  Approxβ Z  V"
proof (goal_cases)
  case 1
  from beta_interp.apx_in[OF 1] obtain U where "Approxβ Z = U" "U β" by auto
  with regions_beta_V show ?thesis by auto
qed

corollary approx_β_closure_α:
  assumes "Z  V" "vabstr Z M"
  shows "Approxβ Z  Closureα Z"
proof -
  note T = region_zone_intersect_empty_approx_correct[OF _ assms(1) _ assms(2-)]
  have "- {R . R  Z  {}} = {R . R  Z = {}}  - V"
  proof (safe, goal_cases)
    case 1 with ℛ_V show False by fast
  next
    case 2 then show ?case using alpha_interp.valid_regions_distinct_spec by fastforce
  next
    case 3 then show ?case using ℛ_V unfolding V_def by blast
  qed
  with T apx_V[OF assms(1)] have "Approxβ Z  - {R . R  Z  {}} = {}" by auto
  then show ?thesis unfolding alpha_interp.cla_def by blast
qed

definition "V'  {Z. Z  V  ( M. vabstr Z M)}"

corollary approx_β_closure_α': "Z  V'  Approxβ Z  Closureα Z"
using approx_β_closure_α unfolding V'_def by auto

text ‹We could prove this more directly too (without using Closureα Z›), obviously›
lemma apx_empty_iff:
  assumes "Z  V" "vabstr Z M"
  shows "Z = {}  Approxβ Z = {}"
using alpha_interp.cla_empty_iff[OF assms(1)] approx_β_closure_α[OF assms] beta_interp.apx_subset
by auto

lemma apx_empty_iff':
  assumes "Z  V'" shows "Z = {}  Approxβ Z = {}"
using apx_empty_iff assms unfolding V'_def by force

lemma apx_V':
  assumes "Z  V" shows "Approxβ Z  V'"
proof (cases "Z = {}")
  case True
  with beta_interp.apx_empty beta_interp.empty_zone_dbm show ?thesis unfolding V'_def neutral by auto
next
  case False
  then have non_empty: "Approxβ Z  {}" using beta_interp.apx_subset by blast
  from beta_interp.apx_in[OF assms] obtain U M where *:
    "Approxβ Z = U" "U β" "Z  Approxβ Z" "vabstr (Approxβ Z) M"
  by blast
  moreover from * beta_interp.ℛ_union have " U  V" by blast
  ultimately show ?thesis using *(1,4) unfolding V'_def by auto
qed

section ‹A New Zone Semantics Abstracting with Approxβ

lemma step_z_V':
  assumes "A  l,Z  l',Z'" "valid_abstraction A X k" "cclk_set A. v c  n" "Z  V'"
  shows "Z'  V'"
proof -
  from assms(3) clock_numbering have numbering: "global_clock_numbering A v n" by metis
  from assms(4) obtain M where M:
    "Z  V" "Z = [M]v,n" "dbm_int M n"
  unfolding V'_def by auto
  from alpha_interp.step_z_V[OF assms(1) M(1)] M(2) assms(1) step_z_dbm_DBM[OF _ numbering]
       step_z_dbm_preserves_int[OF _ numbering assms(2) M(3)]
  obtain M' where M': "Z'  V" "Z' = [M']v,n" "dbm_int M' n" by metis
  then show ?thesis unfolding V'_def by blast
qed

lemma steps_z_V':
  "A  l,Z ↝* l',Z'  valid_abstraction A X k  cclk_set A. v c  n  Z  V'  Z'  V'"
by (induction rule: steps_z.induct) (auto intro: step_z_V')


subsection ‹Single Step›

inductive step_z_beta ::
  "('a, 'c, t, 's) ta  's  ('c, t) zone  's  ('c, t) zone  bool"
("_  _, _ β _, _" [61,61,61] 61)
where
  step_beta: "A  l, Z  l', Z'  A  l, Z β l', Approxβ Z'"

inductive_cases[elim!]: "A  l, u β l',u'"

declare step_z_beta.intros[intro]

lemma step_z_alpha_sound:
  "A  l, Z β l',Z'  valid_abstraction A X k  cclk_set A. v c  n  Z  V'  Z'  {}
    Z''. A  l, Z  l',Z''  Z''  {}"
 apply (induction rule: step_z_beta.induct)
 apply (frule step_z_V')
    apply assumption+
 apply (rotate_tac 4)
 apply (drule apx_empty_iff')
by blast

lemma step_z_alpha_complete:
  "A  l, Z  l',Z'  valid_abstraction A X k  cclk_set A. v c  n  Z  V'  Z'  {}
    Z''. A  l, Z β l', Z''  Z''  {}"
 apply (frule step_z_V')
    apply assumption+
 apply (rotate_tac 4)
 apply (drule apx_empty_iff')
by blast

subsection ‹Multi step›

inductive
  steps_z_beta :: "('a, 'c, t, 's) ta  's  ('c, t) zone  's  ('c, t) zone  bool"
("_  _, _ β* _, _" [61,61,61] 61)
where
  refl: "A  l, Z β* l, Z" |
  step: "A  l, Z β* l', Z'  A  l', Z' β l'', Z''  A  l, Z β* l'', Z''"

declare steps_z_beta.intros[intro]

lemma V'_V: "Z  V'  Z  V" unfolding V'_def by auto

lemma steps_z_beta_V':
  "A  l, Z β* l', Z'  valid_abstraction A X k cclk_set A. v c  n  Z  V'  Z'  V'"
proof (induction rule: steps_z_beta.induct)
  case refl then show ?case by fast
next
  case (step A l Z l' Z' l'' Z'')
  from this(2) obtain Z''' where Z''': "A  l', Z'  l'',Z'''" "Z'' = Approxβ Z'''" by auto
  from step_z_V'[OF this(1)] step have "Z'''  V'" by auto
  from apx_V'[OF V'_V, OF this] Z'''(2) show ?case by auto
qed

lemma alpha_beta_step:
  "A  l, Z β l', Z'  valid_abstraction A X k  cclk_set A. v c  n  Z  V'
    Z''. A  l, Z α l', Z''  Z'  Z''"
  apply (induction rule: step_z_beta.induct)
  apply (frule step_z_V')
    apply assumption+
  apply (rotate_tac 4)
  apply (drule approx_β_closure_α')
  apply auto
done 

subsubsection ‹Soundness›

lemma alpha_beta_step':
  "A  l, Z β l', Z'  valid_abstraction A X k  cclk_set A. v c  n  Z  V'  W  V
   Z  W   W'. A  l, W α l', W'  Z'  W'"
proof (induction rule: step_z_beta.induct)
  case (step_beta A l Z l' Z')
  from alpha_interp.step_z_mono[OF step_beta(1,6)] obtain W' where W':
    "A  l, W  l',W'" "Z'  W'"
  by blast
  from approx_β_closure_α'[OF step_z_V'[OF step_beta(1-4)]]
       alpha_interp.cla_mono[OF this(2)] this(1)
  show ?case by auto
qed

lemma alpha_beta_steps:
  "A  l, Z β* l', Z'  valid_abstraction A X k  cclk_set A. v c  n  Z  V'
    Z''. A  l, Z α* l', Z''  Z'  Z''"
proof (induction rule: steps_z_beta.induct)
  case refl then show ?case by auto
next
  case (step A l Z l' Z' l'' Z'')
  then obtain Z''' where *: "A  l, Z α* l',Z'''" "Z'  Z'''" by auto
  from alpha_beta_step'[OF step.hyps(2) step.prems(1,2) steps_z_beta_V'[OF step.hyps(1) step.prems]
                        alpha_interp.steps_z_alpha_V[OF this(1) V'_V] this(2)] step.prems
  obtain W' where "A  l', Z''' α l'',W'" "Z''  W'" by blast
  with * show ?case by auto
qed

corollary steps_z_beta_sound:
  "A  l, Z β* l', Z'  cclk_set A. v c  n  valid_abstraction A X k  Z  V'  Z'  {}
    Z''. A  l, Z ↝* l', Z''  Z''  {}"
proof (goal_cases)
  case 1
  then have "Z  V" unfolding V'_def by auto
  from alpha_beta_steps[OF 1(1,3,2,4)] obtain Z''' where *:
    "A  l, Z α* l',Z'''" "Z'  Z'''"
    by blast
  from alpha_interp.steps_z_alpha_closure_involutive[OF *(1) 1(3) Z  V›] obtain Z'' where
    Z'': "A  l, Z ↝* l',Z''" "Closureα Z'''  Closureα Z''" "Z''  Z'''"
    by blast
  with alpha_interp.closure_subs[OF alpha_interp.steps_z_alpha_V[OF *(1) Z  V›]] 1(5)
    alpha_interp.cla_empty_iff[OF alpha_interp.steps_z_V, OF this(1) Z  V›] *(2)
  have "Z''  {}" by auto
  with Z'' show ?thesis by auto
qed

subsubsection ‹Completeness›

lemma apx_mono:
  "Z'  V  Z  Z'  Approxβ Z  Approxβ Z'"
proof (goal_cases)
  case 1
  with beta_interp.apx_in have
    "Approxβ Z'  {S. U M. S = U  U β  Z'  S  beta_interp.vabstr S M
                       beta_interp.normalized M}"
  by auto
  with 1 obtain U M where
    "Approxβ Z' = U" "U β" "Z  Approxβ Z'" "beta_interp.vabstr (Approxβ Z') M"
    "beta_interp.normalized M"
  by auto
  with beta_interp.apx_min show ?thesis by auto
qed

lemma step_z_beta_mono:
  "A  l, Z β l', Z'  Z  W  W  V   W'. A  l, W β l', W'  Z'  W'"
proof (goal_cases)
  case 1
  then obtain Z'' where *: "A  l, Z  l',Z''" "Z' = Approxβ Z''" by auto
  from alpha_interp.step_z_mono[OF this(1) 1(2)] obtain W' where
    "A  l, W  l',W'" "Z''  W'"
  by auto
  moreover with *(2) apx_mono[OF alpha_interp.step_z_V] W  V› have
    "Z'  Approxβ W'"
  by metis
  ultimately show ?case by blast
qed

lemma steps_z_beta_V: "A  l, Z β* l', Z'  Z  V  Z'  V"
proof (induction rule: steps_z_beta.induct)
  case refl then show ?case by blast
next
  case (step A l Z l' Z' l'' Z'')
  then obtain Z''' where "A  l', Z'  l'',Z'''" "Z'' = Approxβ Z'''" by auto
  with alpha_interp.step_z_V[OF this(1)] apx_V step(3,4) show "Z''  V" by auto
qed

lemma steps_z_beta_mono:
  "A  l, Z β* l', Z'  Z  W  W  V   W'. A  l, W β* l', W'  Z'  W'"
proof (induction rule: steps_z_beta.induct)
  case refl then show ?case by auto
next
  case (step A l Z l' Z' l'' Z'')
  then obtain W' where "A  l, W β* l',W'" "Z'  W'" by auto
  with step_z_beta_mono[OF step(2) this(2) steps_z_beta_V[OF this(1) step(5)]] show ?case by blast
qed

lemma steps_z_beta_alt:
  "A  l, Z β l', Z'  A  l', Z' β* l'', Z''  A  l, Z β* l'', Z''"
by (rotate_tac, induction rule: steps_z_beta.induct) blast+

lemma steps_z_beta_complete:
  "A  l, Z ↝* l', Z'  valid_abstraction A X k  Z  V
    Z''. A  l, Z β* l',Z''  Z'  Z''"
proof (induction rule: steps_z.induct)
  case refl with apx_empty_iff show ?case by blast
next
  case (step A l Z l' Z' l'' Z'')
  with alpha_interp.step_z_V[OF this(1,5)] obtain Z''' where
    "A  l', Z' β* l'',Z'''" "Z''  Z'''"
  by blast
  with steps_z_beta_mono[OF this(1) beta_interp.apx_subset apx_V[OF alpha_interp.step_z_V[OF step(1,5)]]]
  obtain W' where "A  l', Approxβ Z' β* l'', W'" " Z''  W'" by auto
  moreover with step(1) have "A  l, Z β* l'',W'" by (auto intro: steps_z_beta_alt)
  ultimately show ?case by auto
qed

lemma steps_z_beta_complete':
  "A  l, Z ↝* l',Z'  valid_abstraction A X k  Z  V  Z'  {}
    Z''. A  l, Z β* l',Z''  Z''  {}"
using steps_z_beta_complete by fast

end

end

Theory Normalized_Zone_Semantics

chapter ‹Forward Analysis with DBMs and Widening›

theory Normalized_Zone_Semantics
  imports DBM_Zone_Semantics Approx_Beta
begin

section ‹DBM-based Semantics with Normalization›

subsection ‹Single Step›

inductive step_z_norm ::
  "('a, 'c, t, 's) ta  's  t DBM  (nat  nat)  ('c  nat)  nat  's  t DBM  bool"
("_  _, _ ↝⇘_,_,_ _, _" [61,61,61,61,61] 61)
where step_z_norm:
  "A  l,Dv,n l', D'  A  l,Dk,v,n l', norm (FW D' n) k n"

inductive steps_z_norm ::
  "('a, 'c, t, 's) ta  's  t DBM  (nat  nat)  ('c  nat)  nat  's  t DBM  bool"
("_  _, _ ↝⇘_,_,_⇙* _, _" [61,61,61,61,61] 61)
where
  refl: "A  l, Zk,v,n* l, Z" |
  step: "A  l, Zk,v,n* l', Z'  A  l', Z'k,v,n l'', Z''
         A  l, Zk,v,n* l'', Z''"

context Regions
begin

abbreviation "v'  beta_interp.v'"

abbreviation step_z_norm' ("_  _, _ 𝒩 _, _" [61,61,61] 61)
where
  "A  l, D 𝒩 l', D'  A  l, D(k o v'),v,n l', D'"

abbreviation steps_z_norm' ("_  _, _ 𝒩* _, _" [61,61,61] 61)
where
  "A  l, D 𝒩* l', D'  A  l, D(k o v'),v,n* l', D'"

inductive_cases[elim!]: "A  l, u 𝒩 l',u'"

declare step_z_norm.intros[intro]

lemma apx_empty_iff'':
  assumes "canonical M1 n" "[M1]v,n  V" "dbm_int M1 n"
  shows "[M1]v,n = {}  [norm M1 (k o v') n]v,n = {}"
using beta_interp.apx_norm_eq[OF assms] apx_empty_iff'[of "[M1]v,n"] assms unfolding V'_def by blast

inductive valid_dbm where
  "[M]v,n  V  dbm_int M n  valid_dbm M"

inductive_cases valid_dbm_cases[elim]: "valid_dbm M"

declare valid_dbm.intros[intro]

lemma step_z_valid_dbm:
  assumes "A  l, Dv,n l', D'"
    and "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
  shows "valid_dbm D'"
proof -
  from alpha_interp.step_z_V step_z_dbm_sound[OF assms(1,2)] step_z_dbm_preserves_int[OF assms(1,2)]
       assms(3,4)
  have
    "dbm_int D' n" "A  l, [D]v,n  l', [D']v,n"
  by fastforce+
  with alpha_interp.step_z_V[OF this(2)] assms(4) show ?thesis by auto
qed

lemma FW_zone_equiv_spec:
  shows "[M]v,n = [FW M n]v,n"
apply (rule FW_zone_equiv) using clock_numbering(2) by auto

lemma cn_weak: "kn. 0 < k  (c. v c = k)" using clock_numbering(2) by blast

lemma valid_dbm_non_empty_diag:
  assumes "valid_dbm M" "[M]v,n  {}"
  shows " k  n. M k k  𝟭"
proof safe
  fix k assume k: "k  n"
  have "kn. 0 < k  (c. v c = k)" using clock_numbering(2) by blast
  from k not_empty_cyc_free[OF this assms(2)] show "𝟭  M k k" by (simp add: cyc_free_diag_dest')
qed

lemma non_empty_cycle_free:
  assumes "[M]v,n  {}"
  shows "cycle_free M n"
by (meson assms clock_numbering(2) neg_cycle_empty negative_cycle_dest_diag)

lemma norm_empty_diag_preservation:
  assumes "i  n"
  assumes "M i i < Le 0"
  shows "norm M (k o v') n i i < Le 0"
proof -
  have "¬ Le (k (v' i))  Le 0" by auto
  with assms show ?thesis unfolding norm_def by (auto simp: Let_def less)
qed

lemma norm_FW_empty:
  assumes "valid_dbm M"
  assumes "[M]v,n = {}"
  shows "[norm (FW M n) (k o v') n]v,n = {}" (is "[?M]v,n = {}")
proof -
  from assms(2) cyc_free_not_empty clock_numbering(1) cycle_free_diag_equiv have "¬ cycle_free M n"
  by metis
  from FW_neg_cycle_detect[OF this] obtain i where i: "i  n" "FW M n i i < 𝟭" by auto
  with norm_empty_diag_preservation[folded neutral] have "?M i i < 𝟭" .
  with i  n show ?thesis using beta_interp.neg_diag_empty_spec by auto 
qed

lemma apx_norm_eq_spec:
  assumes "valid_dbm M"
    and "[M]v,n  {}"
  shows "beta_interp.Approxβ ([M]v,n) = [norm (FW M n) (k o v') n]v,n"
proof -
  note cyc_free = non_empty_cycle_free[OF assms(2)]
  from assms(1) FW_zone_equiv_spec[of M] have "[M]v,n = [FW M n]v,n" by (auto simp: neutral)
  with beta_interp.apx_norm_eq[OF fw_canonical[OF cyc_free] _ FW_int_preservation]
      valid_dbm_non_empty_diag[OF assms(1,2)] assms(1)
 show "Approxβ ([M]v,n) = [norm (FW M n) (k o v') n]v,n" by auto
 
qed

print_statement step_z_norm.inducts

(* Crudely copied from step_z_norm.inducts *)
lemma step_z_norm_induct[case_names _ step_z_norm step_z_refl]:
  assumes "x1  x2, x3(k o v'),v,n x7,x8"
    and step_z_norm:
    "A l D l' D'.
        A  l, Dv,n l',D' 
        P A l D l' (norm (FW D' n) (k o v') n)"
  shows "P x1 x2 x3 x7 x8"
using assms by (induction rule: step_z_norm.inducts) auto

lemma FW_valid_preservation:
  assumes "valid_dbm M"
  shows "valid_dbm (FW M n)"
proof standard
  from FW_int_preservation assms show "dbm_int (FW M n) n" by blast
next
  from FW_zone_equiv_spec[of M, folded neutral] assms show "[FW M n]v,n  V" by fastforce
qed

text ‹Obsolete›
lemma norm_diag_preservation:
  assumes "ln. M1 l l  𝟭"
  shows "ln. (norm M1 (k o v') n) l l  𝟭" (is " l  n. ?M l l  𝟭")
proof safe
  fix j assume j: "j  n"
  show "?M j j  𝟭"
  proof (cases "j = 0")
    case True
    with j assms show ?thesis unfolding norm_def neutral less_eq dbm_le_def by auto
  next
    case False
    have *: "real ((k  v') j)  0" by auto
    from j assms have **: "M1 j j  Le 0" unfolding neutral by auto
    have "norm_upper (M1 j j) (real ((k  v') j)) = M1 j j"
    using * ** apply (cases "M1 j j") apply auto by fastforce+
    with assms(1) j False have
      "?M j j = norm_lower (M1 j j) (- real ((k  v') j))"
    unfolding norm_def by auto
    with ** show ?thesis unfolding neutral by auto
  qed
qed

lemma norm_FW_valid_preservation_non_empty:
  assumes "valid_dbm M" "[M]v,n  {}"
  shows "valid_dbm (norm (FW M n) (k o v') n)" (is "valid_dbm ?M")
proof -
  from FW_valid_preservation[OF assms(1)] have valid: "valid_dbm (FW M n)" .
  show ?thesis
  proof standard
    from valid beta_interp.norm_int_preservation show "dbm_int ?M n" by blast
  next
    from fw_canonical[OF non_empty_cycle_free] assms have "canonical (FW M n) n" by auto
    from beta_interp.norm_V_preservation[OF _ this ] valid show "[?M]v,n  V" by fast
  qed
qed

lemma norm_FW_valid_preservation_empty:
  assumes "valid_dbm M" "[M]v,n = {}"
  shows "valid_dbm (norm (FW M n) (k o v') n)" (is "valid_dbm ?M")
proof -
  from FW_valid_preservation[OF assms(1)] have valid: "valid_dbm (FW M n)" .
  show ?thesis
  proof standard
    from valid beta_interp.norm_int_preservation show "dbm_int ?M n" by blast
  next
    from norm_FW_empty[OF assms(1,2)] show "[?M]v,n  V" by fast
  qed
qed

lemma norm_FW_valid_preservation:
  assumes "valid_dbm M"
  shows "valid_dbm (norm (FW M n) (k o v') n)"
using assms norm_FW_valid_preservation_empty norm_FW_valid_preservation_non_empty by metis

lemma norm_beta_sound:
  assumes "A  l,D 𝒩 l',D'" "global_clock_numbering A v n" "valid_abstraction A X k"
  and     "valid_dbm D"
  shows   "A  l,[D]v,n β l',[D']v,n" using assms(2-)
proof (induction A l D l' D' rule: step_z_norm_induct, intro assms(1))
  case (step_z_norm A l D l' D')
  from step_z_dbm_sound[OF step_z_norm(1,2)] have "A  l, [D]v,n  l',[D']v,n" by blast
  then have *: "A  l, [D]v,n β l',Approxβ ([D']v,n)" by force
  show ?case
  proof (cases "[D']v,n = {}")
    case False
    from apx_norm_eq_spec[OF step_z_valid_dbm[OF step_z_norm] False] *
    show ?thesis by auto
  next
    case True
    with norm_FW_empty[OF step_z_valid_dbm[OF step_z_norm] this] beta_interp.apx_empty *
    show ?thesis by auto
  qed
qed

lemma step_z_norm_valid_dbm:
  assumes "A  l, D 𝒩 l',D'" "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
  shows "valid_dbm D'" using assms(2-)
proof (induction A l D l' D' rule: step_z_norm_induct, intro assms(1))
  case (step_z_norm A l D l' D')
  with norm_FW_valid_preservation[OF step_z_valid_dbm[OF step_z_norm]] show ?case by fast
qed

lemma norm_beta_complete:
  assumes "A  l,[D]v,n β l',Z" "global_clock_numbering A v n" "valid_abstraction A X k"
  and     "valid_dbm D"
  obtains D' where "A  l,D 𝒩 l',D'" "[D']v,n = Z" "valid_dbm D'"
proof -
  from assms(1) obtain Z' where Z': "A  l,[D]v,n  l',Z'" "Z = Approxβ Z'" by auto
  from assms(4) have "dbm_int D n" by auto
  with step_z_dbm_DBM[OF Z'(1) assms(2)] step_z_dbm_preserves_int[OF _ assms(2,3)] obtain D' where
    D': "A  l, Dv,n l',D'" "Z' = [D']v,n" "dbm_int D' n"
  by auto
  note valid_D' = step_z_valid_dbm[OF D'(1) assms(2,3)]
  obtain D'' where D'': "D'' = norm (FW D' n) (k  v') n" by auto
  show ?thesis
  proof (cases "Z' = {}")
    case False
    with D' have *: "[D']v,n  {}" by auto
    from apx_norm_eq_spec[OF valid_D' this] D'' D'(2) Z'(2) assms(4) have "Z = [D'']v,n" by auto
    with norm_FW_valid_preservation[OF valid_D'] D' D'' * that[of D''] assms(4)
    show thesis by blast
  next
    case True
    with norm_FW_empty[OF valid_D'[OF assms(4)]] D'' D' Z'(2)
         norm_FW_valid_preservation[OF valid_D'[OF assms(4)]] beta_interp.apx_empty
    show thesis
    apply -
    apply (rule that[of D''])
      apply blast
    by fastforce+
  qed
qed

subsection ‹Multi step›

declare steps_z_norm.intros[intro]

lemma steps_z_norm_induct[case_names _ refl step]:
  assumes "x1  x2, x3(k o v'),v,n* x7,x8"
    and "A l Z. P A l Z l Z"
    and
    "A l Z l' Z' l'' Z''.
        A  l, Z(k o v'),v,n* l',Z' 
        P A l Z l' Z' 
        A  l', Z'(k o v'),v,n l'',Z''  P A l Z l'' Z''"
  shows "P x1 x2 x3 x7 x8"
using assms by (induction rule: steps_z_norm.induct) auto

lemma norm_beta_sound_multi:
  assumes "A  l,D 𝒩* l',D'" "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
  shows "A  l,[D]v,n β* l',[D']v,n  valid_dbm D'" using assms(2-)
proof (induction A l D l' D' rule: steps_z_norm_induct, intro assms(1))
  case refl then show ?case by fast
next
  case (step A l Z l' Z' l'' Z'')
  then have "A  l, [Z]v,n β* l',[Z']v,n" "valid_dbm Z'" by fast+
  with norm_beta_sound[OF step(2,4,5)] step_z_norm_valid_dbm[OF step(2,4,5)] show ?case by force
qed

lemma norm_beta_complete_multi:
  assumes "A  l,[D]v,n β* l',Z" "global_clock_numbering A v n" "valid_abstraction A X k"
  and     "valid_dbm D"
  obtains D' where "A  l,D 𝒩* l',D'" "[D']v,n = Z" "valid_dbm D'"
using assms
proof (induction A l "[D]v,n" l' Z arbitrary: thesis rule: steps_z_beta.induct)
  case refl
  from this(1)[OF steps_z_norm.refl] this(4) show thesis by fast
next
  case (step A l l' Z' l'' Z'')
  from step(2)[OF _ step(5,6,7)] obtain D' where D':
    "A  l, D 𝒩* l',D'" "[D']v,n = Z'" "valid_dbm D'"
  .
  with norm_beta_complete[OF _ step(5,6), of l' D' l'' Z''] step(3) obtain D'' where D'':
    "A  l', D' 𝒩 l'',D''" "[D'']v,n = Z''" "valid_dbm D''"
  by auto
  with D'(1) step(4)[of D''] show thesis by blast
qed

lemma norm_beta_equiv_multi:
  assumes "global_clock_numbering A v n" "valid_abstraction A X k"
  and     "valid_dbm D"
  shows "( D'. A  l,D 𝒩* l',D'  Z = [D']v,n)  A  l,[D]v,n β* l',Z"
using norm_beta_complete_multi[OF _ assms] norm_beta_sound_multi[OF _ assms] by metis


subsection ‹Connecting with Correctness Results for Approximating Semantics›

lemma steps_z_norm_complete':
  assumes "A  l,[D]v,n ↝* l',Z" "global_clock_numbering A v n" "valid_abstraction A X k"
  and "valid_dbm D"
  shows " D'. A  l, D 𝒩* l',D'   Z  [D']v,n"
proof -
  from steps_z_beta_complete[OF assms(1,3)] assms(4) obtain Z'' where Z'':
    "A  l, [D]v,n β* l',Z''" "Z  Z''"
  by auto
  from this(2) norm_beta_complete_multi[OF this(1) assms(2,3,4)] show ?thesis by metis
qed

lemma valid_dbm_V':
  assumes "valid_dbm M"
  shows "[M]v,n  V'"
using assms unfolding V'_def by force

lemma steps_z_norm_sound':
  assumes "A  l,D 𝒩* l',D'"
    and "global_clock_numbering A v n"
    and "valid_abstraction A X k"
    and "valid_dbm D"
    and "[D']v,n  {}"
  shows "Z. A  l,[D]v,n ↝* l',Z  Z  {}"
proof -
  from norm_beta_sound_multi[OF assms(1-4)] have "A  l, [D]v,n β* l',[D']v,n" by fast
  from steps_z_beta_sound[OF this _ assms(3) valid_dbm_V'] assms(2,4,5) show ?thesis by blast
qed


section ‹The Final Result About Language Emptiness›

lemma steps_z_norm_complete:
  assumes "A  l, u →* l', u'" "u  [D]v,n"
    and   "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
  shows " D'. A  l, D 𝒩* l',D'  u'  [D']v,n"
using steps_z_norm_complete'[OF _ assms(3-)] steps_z_complete[OF assms(1,2)] by fast

lemma steps_z_norm_sound:
  assumes "A  l,D 𝒩* l',D'"
    and   "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
    and   "[D']v,n  {}"
  shows " u  [D]v,n.  u'. A  l, u →* l', u'"
using steps_z_norm_sound'[OF assms] steps_z_sound by fast

theorem steps_z_norm_decides_emptiness:
  assumes "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
  shows "( D'. A  l, D 𝒩* l',D'  [D']v,n  {})
      ( u  [D]v,n.  u'. A  l, u →* l', u')"
using steps_z_norm_sound[OF _ assms] steps_z_norm_complete[OF _ _ assms] by fast


section ‹Finiteness of the Search Space›

abbreviation "dbm_default M  ( i > n.  j. M i j = 𝟭)  ( j > n.  i. M i j = 𝟭)"

lemma "a     b. a = real_of_int b" using Ints_cases by auto

lemma norm_default_preservation:
  "dbm_default M  dbm_default (norm M (k o v') n)"
by (simp add: norm_def)

lemma normalized_integral_dbms_finite:
  "finite {norm M (k o v') n | M. dbm_int M n  dbm_default M}"
proof -
  let ?u = "Max {(k o v') i | i. i  n}" let ?l = "- ?u"
  let ?S = "(Le ` {d :: int. ?l  d  d  ?u})  (Lt ` {d :: int. ?l  d  d  ?u})  {}"
  from finite_set_of_finite_funs2[of "{0..n}" "{0..n}" ?S] have fin:
    "finite {f. x y. (x  {0..n}  y  {0..n}  f x y  ?S)
                 (x  {0..n}  f x y = 𝟭)  (y  {0..n}  f x y = 𝟭)}" (is "finite ?R")
  by auto
  { fix M :: "t DBM" assume A: "dbm_int M n" "dbm_default M"
    let ?M = "norm M (k o v') n"
    from beta_interp.norm_int_preservation[OF A(1)] norm_default_preservation[OF A(2)] have
      A: "dbm_int ?M n" "dbm_default ?M"
    by blast+
    { fix i j assume "i  {0..n}" "j  {0..n}"
      then have B: "i  n" "j  n" by auto
      have "?M i j  ?S"
      proof (cases "?M i j = ")
        case True then show ?thesis by auto
      next
        case False
        note not_inf = this
        with B A(1) have "get_const (?M i j)  " by auto
        moreover have "?l  get_const (?M i j)  get_const (?M i j)  ?u"
        proof (cases "i = 0")
          case True
          show ?thesis
          proof (cases "j = 0")
            case True
            with i = 0 A(1) B have
              "?M i j = norm_lower (norm_upper (M 0 0) 0) 0"
            unfolding norm_def by auto
            also have "    get_const  = 0" by (cases "M 0 0"; fastforce)
            finally show ?thesis using not_inf by auto
          next
            case False
            with i = 0 B not_inf have "?M i j  Le 0" "Lt (-real (k (v' j)))  ?M i j"
            by (unfold norm_def, auto simp: Let_def, unfold less[symmetric], auto)
            with not_inf have "get_const (?M i j)  0" "-k (v' j)  get_const (?M i j)"
            by (cases "?M i j"; auto)+
            moreover from j  n have "- (k o v') j  ?l" by (auto intro: Max_ge)
            ultimately show ?thesis by auto
          qed
        next
          case False
          then have "i > 0" by simp
          show ?thesis
          proof (cases "j = 0")
            case True
            with i > 0 A(1) B not_inf have "Lt 0  ?M i j" "?M i j  Le (real ((k  v') i))"
            by (unfold norm_def, auto simp: Let_def, unfold less[symmetric], auto)
            with not_inf have "0  get_const (?M i j)" "get_const (?M i j)  k (v' i)"
            by (cases "?M i j"; auto)+
            moreover from i  n have "(k o v') i  ?u" by (auto intro: Max_ge)
            ultimately show ?thesis by auto
          next
            case False
            with i > 0 A(1) B not_inf have
              "Lt (-real ((k  v') j))  ?M i j" "?M i j  Le (real ((k  v') i))"
            by (unfold norm_def, auto simp: Let_def, unfold less[symmetric], auto)
            with not_inf have "- k (v' j)  get_const (?M i j)" "get_const (?M i j)  k (v' i)"
            by (cases "?M i j"; auto)+
            moreover from i  n j  n have "(k o v') i  ?u" "(k o v') j  ?u" by (auto intro: Max_ge)
            ultimately show ?thesis by auto
          qed
        qed
        ultimately show ?thesis by (cases "?M i j"; auto elim: Ints_cases)
      qed
    } moreover
    { fix i j assume "i  {0..n}"
      with A(2) have "?M i j = 𝟭" by auto
    } moreover
    { fix i j assume "j  {0..n}"
      with A(2) have "?M i j = 𝟭" by auto
    } moreover note the = calculation
  } then have "{norm M (k o v') n | M. dbm_int M n  dbm_default M}  ?R" by blast
  with fin show ?thesis by (blast intro: finite_subset)
qed

end


section ‹Appendix: Standard Clock Numberings for Concrete Models›

locale Regions' =
  fixes X and k :: "'c  nat" and v :: "'c  nat" and n :: nat and not_in_X
  assumes finite: "finite X"
  assumes clock_numbering': " c  X. v c > 0" " c. c  X  v c > n"
  assumes bij: "bij_betw v X {1..n}"
  assumes non_empty: "X  {}"
  assumes not_in_X: "not_in_X  X"

begin

lemma inj: "inj_on v X" using bij_betw_imp_inj_on bij by simp

lemma cn_weak: " c. v c > 0" using clock_numbering' by force

lemma in_X: assumes "v x  n" shows "x  X" using assms clock_numbering'(2) by force

end

sublocale Regions'  Regions
proof (unfold_locales, auto simp: finite clock_numbering' non_empty cn_weak not_in_X, goal_cases)
  case (1 x y) with inj in_X show ?case unfolding inj_on_def by auto
next
  case (2 k)
  from bij have "v ` X = {1..n}" unfolding bij_betw_def by auto
  from 2 have "k  {1..n}" by simp
  then obtain x where "x  X" "v x = k" unfolding image_def
  by (metis (no_types, lifting) v ` X = {1..n} imageE)
  then show ?case by blast
next
  case (3 x) with bij show ?case unfolding bij_betw_def by auto
qed

(* This is for automata carrying real time annotations *)
lemma standard_abstraction:
  assumes "finite (clkp_set A)" "finite (collect_clkvt (trans_of A))" "(_,m::real)  clkp_set A. m  "
  obtains k :: "'c  nat" where "valid_abstraction A (clk_set A) k"
proof -
  from assms have 1: "finite (clk_set A)" by auto
  have 2: "collect_clkvt (trans_of A)  clk_set A" by auto
  from assms obtain L where L: "distinct L" "set L = clkp_set A" by (meson finite_distinct_list)
  let ?M = "λ c. {m . (c, m)  clkp_set A}"
  let ?X = "clk_set A"
  let ?m = "map_of L"
  let ?k = "λ x. if ?M x = {} then 0 else nat (floor (Max (?M x)) + 1)"
  { fix c m assume A: "(c, m)  clkp_set A"
    from assms(1) have "finite (snd ` clkp_set A)" by auto
    moreover have "?M c  (snd ` clkp_set A)" by force
    ultimately have fin: "finite (?M c)" by (blast intro: finite_subset)
    then have "Max (?M c)  {m . (c, m)  clkp_set A}" using Max_in A by auto
    with assms(3) have "Max (?M c)  " by auto
    then have "floor (Max (?M c)) = Max (?M c)" by (metis Nats_cases floor_of_nat of_int_of_nat_eq)
    with A have *: "?k c = Max (?M c) + 1"
    proof auto
      fix n :: int and x :: real
      assume "Max {m. (c, m)  clkp_set A} = real_of_int n"
      then have "real_of_int (n + 1)  "
        using ‹Max {m. (c, m)  clkp_set A}   by auto
      then show "real (nat (n + 1)) = real_of_int n + 1"
        by (metis Nats_cases ceiling_of_int nat_int of_int_1 of_int_add of_int_of_nat_eq)
    qed
    from fin A have "Max (?M c)  m" by auto
    moreover from A assms(3) have "m  " by auto
    ultimately have "m  ?k c" "m  " "c  clk_set A" using A * by force+
  }
  then have "(x, m)clkp_set A. m  ?k x  x  clk_set A  m  " by blast
  with 1 2 have "valid_abstraction A ?X ?k" by - (standard, assumption+)
  then show thesis ..
qed

definition
  "finite_ta A  finite (clkp_set A)  finite (collect_clkvt (trans_of A))
                  ((_,m::real)  clkp_set A. m  )  clk_set A  {}  -clk_set A  {}"

lemma finite_ta_Regions':
  fixes A :: "('a, 'c, real, 's) ta"
  assumes "finite_ta A"
  obtains v n x where "Regions' (clk_set A) v n x"
proof -
  from assms obtain x where x: "x  clk_set A" unfolding finite_ta_def by auto
  from assms(1) have "finite (clk_set A)" unfolding finite_ta_def by auto
  with standard_numbering[of "clk_set A"] assms obtain v and n :: nat where
            "bij_betw v (clk_set A) {1..n}"
            "cclk_set A. 0 < v c" "c. c  clk_set A  n < v c"
  by auto
  then have "Regions' (clk_set A) v n x" using x assms unfolding finite_ta_def by - (standard, auto)
  then show ?thesis ..
qed

lemma finite_ta_RegionsD:
  assumes "finite_ta A"
  obtains k :: "'b  nat" and v n x where
    "Regions' (clk_set A) v n x" "valid_abstraction A (clk_set A) k" "global_clock_numbering A v n"
proof -
  from standard_abstraction assms obtain k :: "'b  nat" where k:
    "valid_abstraction A (clk_set A) k" 
  unfolding finite_ta_def by blast
  from finite_ta_Regions'[OF assms] obtain v n x where *: "Regions' (clk_set A) v n x" .
  then interpret interp: Regions' "clk_set A" k v n x .
  from interp.clock_numbering have "global_clock_numbering A v n" by blast
  with * k show ?thesis ..
qed

definition valid_dbm where "valid_dbm M n  dbm_int M n  ( i  n. M 0 i  𝟭)"

lemma dbm_positive:
  assumes "M 0 (v c)  𝟭" "v c  n" "DBM_val_bounded v u M n"
  shows "u c  0"
proof -
  from assms have "dbm_entry_val u None (Some c) (M 0 (v c))" unfolding DBM_val_bounded_def by auto
  with assms(1) show ?thesis
  proof (cases "M 0 (v c)", goal_cases)
    case 1
    then show ?case unfolding less_eq neutral using order_trans by (fastforce dest!: le_dbm_le)
  next
    case 2
    then show ?case unfolding less_eq neutral
    by (auto dest!: lt_dbm_le) (meson less_trans neg_0_less_iff_less not_less)
  next
    case 3
    then show ?case unfolding neutral less_eq dbm_le_def by auto
  qed
qed


lemma valid_dbm_pos:
  assumes "valid_dbm M n"
  shows "[M]v,n  {u.  c. v c  n  u c  0}"
using dbm_positive assms unfolding valid_dbm_def unfolding DBM_zone_repr_def by fast

lemma (in Regions') V_alt_def:
  shows "{u.  c. v c > 0  v c  n  u c  0} = V"
unfolding V_def using clock_numbering by metis

text ‹
  An example of obtaining concrete models from our formalizations.
›
lemma steps_z_norm_sound_spec:
  assumes "finite_ta A"
  obtains k v n where
  "A  l,Dk,v,n* l',D'  valid_dbm D n  [D']v,n  {}
   (Z. A  l, [D]v,n ↝* l',Z  Z  {})"
proof -
  from finite_ta_RegionsD[OF assms(1)] obtain k :: "'b  nat" and v n x where *:
    "Regions' (clk_set A) v n x" "valid_abstraction A (clk_set A) k" "global_clock_numbering A v n"
  .
  from this(1) interpret interp: Regions' "clk_set A" k v n x .
  define v' where "v' i = (if i  n then (THE c. c  clk_set A  v c = i) else x)" for i
  { fix l D l' D'
    assume step: "A  l,D(k o v'),v,n* l',D'"
    and valid: "valid_dbm D n" and non_empty: "[D']v,n  {}"
    from valid_dbm_pos[OF valid] interp.V_alt_def have "[D]v,n  interp.V" by blast
    with valid have valid: "interp.valid_dbm D" unfolding valid_dbm_def by auto
    from step have "interp.steps_z_norm' A l D l' D'" unfolding v'_def interp.beta_interp.v'_def .
    note this = interp.steps_z_norm_sound'[OF this *(3,2) valid non_empty]
  }
  then show thesis by (blast intro: that)
qed

end